Piease type a plu£ sign inside this box | [ 



r. - -I *• A * r^r^^r. Patent 30(1 Trademark Off 106: U.S. DEPARTMENT OF COMMERCE 

Under the PaoerworK Reduction Act of 1995, no persons are required to respond to a coHection of information unless it dispiavs a valid 0MB control numhflr. 



Approved for use through 09/30/2000. 0MB 0651 -0032 — 




2 UTILITY 
?>ATENT APPLICATION 
1 TRANSMITTAL 

m new nonprovisional applications under 37 C.F.R. § 1.53(b)) 



Attorney Docket No. 



ETS-TCA 



First Inventor or Application fdentifier PETER BRITTINGEiAM 
Title [CXMPUTER-BASED TEST-ITEiy[ GENEE^TICN AND CTO 



Express Mail Label No, 



EI46981 591 6US 




APPLICATION ELEMENTS 

■mPEP chapter 600 concerning utifity patent application contents. 



Assistant Commissioner for Patents f^; 
ADDRESS TO: Box Patent Application 



X 



1; 



* Fee Transmittal Form (e.g., PTO/SB/17) 
(Submit an original and a duplicate for fee processing) 

Specification [Total Pages 

(preferred arrangement set forth below) 

- Descriptive title of the Invention 

- Cross References to Related Applications 

- Statement Regarding Fed sponsored R&D 

- Reference to Microfiche Appendix 

- Background of the Invention 

- Brief Summary of the Invention 

- Brief Description of the Drawings {if filed) 

- Detailed Description 

- Claim(s) 

- Abstract of the Disclosure 
Drawing(s) (35 U.S.C. 1 13) [Total Sheets 



5. 1 I Microfiche Computer Program (Appendix) 

6, Nucleotide and/or Amino Acid Sequence Submission 
{if ap plicabl e, all necessary) 



Computer Readable Copy 

Paper Copy (identical to computer copy) 

Statement verifying identity of above copies 



©ath or Declaration 

; f|a. 

41 b. 



[Total Pages 



118 



Newly executed (original or copy) 

Copy 1 
(for cor 

□ 



Copy from a prior application (37 C.F.R. § 1.63(d)) 
(for continuation/divisional with Box 16 completed) 

DELETION OF INVENTORfSl 
Signed statement attached deleting 
inventor(s) named in the prior application. 
see 37 C.F.R. §§ 1.63(d)(2) and 1.33(b). 



NOTE FOR ITEMS 1 & 13: IN ORDER TO RF FNTTri Pn TH 0AY<tMAi / ca/T7tv 
F^£S, A SMALL ENTfTY STATEMENT IS REQUIRED (37 C.F.R. § 1.27), EXCEPT 
mONE FILED IN A PRIOR APPLICATION IS RELIED UPON (37 C ER. S 1.28). 



ACCOMPANYING APPLICATION PARTS 



Assignment Papers (cover sheet & document(s)) 

37 C.F.R.§3.73(b) Statement I 1 Power of 

(when there is an assignee) I I Attomey 

English Translation Document (if applicable) 
Infomnation Disclosure I | Copies of IDS 
Statement (IDS)/PT0-1 449 I I Citations 

I I Preliminary Amendment 

2 nn ^^^^^ Receipt Postcard (MPEP 503) 
* I 1 (Should be specifically itemized) 

□ * Small Entity , , ^ ^ r-. ^ - 
Statement(s) ^"^^"^'^^ pnor application 

(PTO/SB/09-12) Status still proper and desired 

Certified Copy of Priority Document(s) 
(if foreign priority is claimed) 

Other: ^^^"(^.V..?^?.?AS'..?5.^?.^5..9.?5.,^^^^^ ^^^'^ 5Wee€ 

PictoQ Soy^t« CO06 ^/'^NTjlX LSX Fh^^SJ 

fo4 SiFSO f^tcAD 6'}^'TtiW'W^Tc4'"^^^^ 



X 



'^^'ftX CONTINUING APPLICATION, check appropriate box, and supply the requisite infomiation below and in a preliminary amendment: 
Tl Continuation Q Divisional Continuation-in-part (GIF) of prior application No: 
Prior application infomiation: Examiner Group / Art Unit: 



For CONTINUATION or DIVISIONAL APPS only : The entire disclosure of the prior application, from which an oath or declaration is supplied 
under Box 4b, is considered a part of the disclosure of the accompanying continuation or divisional application and is hereby hcorporated bv 
reference. The incorporation can onlv be relied upon when a portion has been inadvertently omitted from the submitted application parts 



17. CORRESPONDENCE ADDRESS 



i — I Customer Number or Bar Code Label 



i.ilP.?J^.!^.9Jdf}2T.ff..t^^^^^^ ^3bel here) 



or Correspondence address below 



Name 



Michael I. Chakansky, Esq, 

Sills Cuinmis Radin Tischman Epstein 8c Gross PC 



Address 



One Riverfront Plaza 
Newark, NJ 07102 



City 



Newark 



Country 



USA 



Staie 



Telephone 



NJ 



973-643-5875 



Zip Code 



07102 



973-643-6500 



Name (Print/Type) 


Michael J^. gt7akansky7 y? 


y 1 Registration No. (Attorney/Agent) 


31 ,600 


> 


Signature 




1 Date 


9/1 /OO 



-iments on 



Steteme'nt: Th^form is estitjj^ted to take 0.2 hours to compl^. Time will vary depending upon the needs of the individual case Any 

sent to the Chief Information Officer, Patent and Trademark Office 



ra"Sn!-SSorDC2^2^ SENDTO: Assistant Commisslonerfor Patents, 



PTO/SB/17 (12/99) 
Approved for use through 09/30/2000. 0MB 0651-0032 
, , ^ iu r» . Patent and Trademark Office: U.S. DEPARTMENT OF COMMERCE 

UnderthePaperwor^^ Act of 1995. no persons are required to rpspond to a coHection of informat.nn ..niess it displays a valid OMB control number. 



0=EE TRANSMITTAL 
for FY 2000 

Patent fees are subject to annual revision. 
Small Entity payments must be supported by a small entity statement, 
otherwise large entity fees must be paid. See Forms PTOISBf09-12. 
See 37 CF.R. §§ 1.27 and 1,28. 



Complete if Known 



Application Number 



Filing Date 



First Named Inventor 



Examiner Name 



TOTAL AMOUNT OF PAYMENT 



($) 846 



Group / Art Unit 



Attorney Docket No. 



9/1 /OO 



PETEIR BRITTINGHAM 



ETS-TGA 



METHOD OF PAYMENT (check one) 



FEE CALCULATION (continued) 



1. 

Deposit 
Account 
Number 

Deposit 
Account 
Name 



The Commissioner is hereby authorized to charge 
indicated fees and credit any overpayments to: 



05-0426 



3. ADDITIONAL FEES 

Large Entity Small Entity 
Fee Fee Fee Fee 
Code ($) Code ($) 



Fee Description 



EDQCATICNAL TESTING SERVICE 



rT7| Charge Any Additional Fee Required 
LJ Under 37 CFR§§ 1.16 and 1.17 



2. n Payment Enclosed: 

□ check □ Money |-| ^^^^ 



FEE CALCULATION 



1. BASIC FILING FEE 
Large Entity Small Entity 



Fee 


Fee 


Fee 


Fee 


Fee Description 


Code ($) 


Code ($) 


101 


690 


201 


345 


Utility filing fee 


106 


310 


206 


155 


Design filing fee 


107 


480 


207 


240 


Plant filing fee 


108 


690 


208 


345 


Reissue filing fee 


114 


150 


214 


75 


Provisional filing fee 



Fee Paid 



690 



SUBTOTALS) ($)690 



Fee from 



2. EXTRA CLAIM FEES 

Extraj£laims below Fee Paid 

Total Claims 1^0 I -20** 4 0 I X I 9 I =| 0 I 

Independent ^ . 3.. ^ ^ TWI 



IVIultlple Dependent | 

'or number previously paid, if greater; For Reissues, see below 
Large Entity Small Entity 



Fee Fee 
Code ($) 


Fee Fee 
Code ($) 


Fee Description 


103 


18 


203 


9 


Claims in excess of 20 


102 


78 


202 


39 


Independent claims in excess of 3 


104 


260 


204 


130 


Multiple dependent claim, if not paid 


109 


78 


209 


39 


** Reissue independent claims 
over original patent 


110 


18 


210 


9 


** Reissue claims in excess of 20 



105 


130 


205 


65 


Surcharge - late filing fee or oath 


127 


50 


227 


25 


Surcharge - late provisional filing fee or 
cover sheet. 


139 


130 


139 


130 


Non-English specification 


147 


2 520 


147 


2,520 


For filing a request for reexamination 


112 


920* 


112 


920* 


Requesting publication of SIR prior to 
Examiner action 


113 


1,840* 


1 13 1,840* Requesting publication of SIR after 
Examiner action 


115 


110 


215 


55 


Extension for reply within first month 


116 


380 


216 


190 


Extension for reply within second month 


117 


870 


217 


435 


Extension for reply within third month 


118 


1,360 


218 


680 


Extension for reply within fourth month 


128 


1,850 


228 


925 


Extension for reply within fifth month 


119 


300 


219 


150 


Notice of Appeal 


120 


300 


220 


150 


Filing a brief in support of an appeal 


121 


260 


221 


130 


Request for oral hearing 


138 


1,510 


138 


1.510 


Petition to institute a public use proceeding 


140 


110 


240 


55 


Petition to revive - unavoidable 


141 


1,210 


241 


605 


Petition to revive - unintentional 


142 


1,210 


242 


605 


Utility issue fee (or reissue) 


143 


430 


243 


215 


Design issue fee 


144 


580 


244 


290 


Plant issue fee 


122 


130 


122 


130 


Petitions to the Commissioner 


123 
126 


50 
240 


123 
126 


50 
240 


Petitions related to provisional applications 
Submission of Information Disclosure Stmt 


581 
146 
149 


40 
690 
690 


581 
246 
249 


40 
345 
345 


Recording each patent assignment per 
property (times number of properties) 

Filing a submission after final rejection 
(37 CFR§ 1.129(a)) 

For each additional invention to be 



and over original patent 
SUBTOTAL (2) 



Other fee (specify) . 
Other fee (specify) . 



($) 846 



* Reduced by Basic Filing Fee Paid SUBTOTAL (3) ($) 



Fee Paid 



SUBMnTED BY 



Complete Of applicable) 



Name (PnntfType) 



^ I Registration No. 




31,600 



Telephone 973-643_5875 



Signature 



Date 



9/1/00 



WARNING 



Information on this form may become piiblic. Credit card information should not be 
included on this form. Provide credit card mformation and authorization on PTO-2038. 

Burden Hour Statement: This form is estimated to take 0. 
the amount of time you are required to complete this forn EI4698 1591 6US 
DO NOT SEND FEES OR COMPLETED FORMS TO TH! 



spending upon the needs of the individual case. Any comments on 
on Officer, Patent and Trademark Office, Washington, DC 20231. 
ommissionerfor Patents, Washington, DC 20231. 



IN THE UNITED STATES PATENT AND TRADEMARK OFFICE 



BEFORE THE PATENT EXAMINING OPERATION 



ATTN'Y DOCKET NO.: ETS-TCA 

APPLICATION OF: PETER BRITTINGHAM, MARY E. MORLEY, MARK K. 

SINGLEY, MARK G. ZELMAN, KRISHNA N. JHA, 
JAMES H. FIFE, ROBERT L. RARICH, IRVIN R. 
KATZ, RANDY E. BENNETT 

FOR: COMPUTER-BASED TEST- ITEM GENERATION AND 

CLONING 



PATENT SPECIFICATION 



301256.1 



EI469815916US 



TABLE OF CONTENTS 



BACKGROUND OF THE INVENTION 1 

FIELD OF THE INVENTION 1 

SUMMARY OF THE INVENTION 3 

BRIEF DESCRIPTIONS OF THE DRAWINGS 6 

DETAILED SUMMARY OF THE INVENTION 9 

THE COMPUTER ENVIRONMENT 9 

PROLOG IV ......... 9 

CREATING A NEW TEST ITEM 10 

NEW FAMILY PROPERTIES DIALOG BOX 11 

MULTIPLE CHOICE MODEL \ [ 13 

CREATING A TEST ITEM MODEL I5 

DEFINING VARIABLES BY INDICATING VALUES THE VARIABLES 

CAN TAKE ON I5 

DEFINING VARIABLES DIRECTLY IN VARIABLES WINDOW 

16 

VARIABILIZING BY USING NAMING CONVENTION AND 

HIGHLIGHTING 16 

VARIABLE NAMING CONVENTION FOR USE IN AUTO- 
DEFINING VARIABLES 16 

IDENTIFYING ELEMENTS OF THE TEST ITEM TO BE 

VARIABILIZED 17 

VARIABILIZING BY USING PRIOR UNFROZEN MODELS OR 

CHILDREN THEREOF 19 

EDITING STRING VARIABLES . . 2 0 

CREATING AND IMPORTING STRING VALUES 22 

Using the "Add" Button 2 2 

Using the "Export Strings" and "Import 

String" Buttons 23 

EDITING INTEGER VARIABLES 24 

SPECIFYING THE CONSTRAINTS . . 25 

Operators 2 6 

Variables 2 6 

Functions 2 6 

Constraining "IKey" 2 6 

-i- 



Exporting and Importing Constraints 27 

Constraining the Distractors 27 

Testing the Constraints 28 

GENERATING TEST ITEM VARIANTS 29 

WORKING WITH GENERATED VARIANTS 31 

ACCEPTING VARIANTS . . . . 31 

DEFERRING AND DISCARDING VARIANTS [ 31 

CREATING NEW VARIANT MODELS FROM A GENERATED VARIANT 

32 

ACCEPTED VARIANTS AND NEW FAMILY MODELS 32 

WORKING WITH MODELS AND ACCEPTED VARIANTS 33 

EDITING THE PROFILE OF A VARIANT . . 34 

The GRE Difficulty Portion of the Profile of a 

Variant Window 35 

WORKING WITH FAMILY MEMBERS ! .' ! 36 

Using a New Active Model to Generate Far Variants 

36 

Creating Still More Models 37 

PRINT OPTIONS 3g 

GRE QUANTITATIVE COMPARISON ITEMS 39 

GMAT DATA SUFFICIENCY ITEMS 40 

FURTHER EXAMPLES OF ITEM MODELS 4 0 

PROLOG SIMULTANEOUS CONSTRAINT SOLVER 41 

HLP4lib.p4 41 

Pr IgExpr .1 4I 

PrlgExpr.y [ 4I 

hlP4API.h 42 

TCA CONSTRAINT LANGUAGE 43 

NOTATIONAL CONVENTION . . . 44 

TCA CONSTRAINT LANGUAGE IN DETAIL . . 44 

BASIC ELEMENTS ' 45 

Constants 45 

Variables 45 



Lists 47 

Functions . 47 

Algebraic Expressions (referred to as: 

AlgExpr) 51 

CONSTRAINT SPECIFICATION 53 

Type Constraint Specification 53 

Optimizable-Relation Specification ... 53 

Precision Specification 55 

Relational Constraints (RelExpr) .... 55 

Ranges 55 

Enumerated Range 57 

if-then-else Constraint 53 

if -then-elseif Constraint 59 

Freeze Constraint 60 

Primitive succeed and fail constraints . 60 

Combining Constraints 61 

WRITING CONSTRAINTS IN TCA CONSTRAINT LANGUAGE . . 61 

SOME TECHNIQUES TO SOLVE CONSTRAINTS IN TCA . 63 

Variable Type Specification 63 

Range specification 64 

Enumerated-Range Specification 64 

Efficient Solving 64 

Representing lists and tables 65 



Bidirectionality of functions and operators 

66 



-iii- 



Constraints are Solved in Order- independent 

Fashion g5 

Constraints are Solved as a Whole .... 66 

Variable Names are the Links to Bind Various 
Constraints 57 

Use of Sets and Ranges 67 

Logical Operators 68 

Equality by Assigning Same Variable Name 68 

VISUAL BASIC SOURCE CODE APPENDIX 59 

PROLOG SOURCE CODE APPENDIX 73 

CLAIMS 

ABSTRACT 



-iv- 



COMPUTER-BASED ITEM GENERATION 



This application claims priority from U.S. Provisional 
Application Ser. No. 60/152,121, filed September 1, 1999, the 
disclosure of which is incorporated herein by reference. A 
portion of the disclosure of this patent document contains 
material which is subject to copyright protection. The copyright 
owner has no objection to the facsimile reproduction by anyone of 
the patent disclosure, as it appears in the Patent and Trademark 
Office public patent files or records, but otherwise reserves all 
copyright rights whatsoever. 



BACKGROUND OF THE INVENTION 



FIELD OF THE INVENTION 

The present invention relates to computer-based technology 
in the generation of test items. In particular, to the 
semi -automated (i.e. test -developer assisted) generation of 
surface-level (near), medium-level, and deep (far) clones 
('Variants") of test items. 

Applicants' assignee, Education Testing Service administers 
many different tests, including the following three tests. The 
Graduate Management Admission Test® (GMAT®) Program is used by 



graduate business schools and measures general verbal, 
mathematical, and analytical writing skills that an individual 
has developed over a long period of time. The Graduate Record 
Examinations® (GRE®) Program provides tests that assist graduate 
schools and departments in graduate admissions activities. Tests 
offered include the General Test, which measures developed 
verbal, quantitative, and analytical abilities, and the Subject 
Tests, which measure achievement in 14 different fields of study. 
The SAT® Program consists of the SAT 1: Reasoning Test and SAT 
II: Subject Tests. The SAT I is a three-hour test, primarily 
multiple-choice, that measures verbal and mathematical reasoning 
abilities. The SAT II: Subject Tests are one-hour, mostly 
multiple-choice, tests in specific subjects. These tests measure 
knowledge of particular subjects and the ability to apply that 
15 CI knowledge. The SAT® Program tests are used by colleges for 
admission or placement purposes. 

These and other tests require a large number of test items. 
However, creating tests items is an expensive and time consuming 
process. Therefore, there is a need for a process and system for 
20 creating test items in a relatively cost effective and 
expeditious manner. 
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It is an object of the present invention to provide a 
process and system for the cost effective and expeditious 
creation of test items. 

It is a further object of the present invention to provide a 
process and system for the cost effective and expeditious 
generation of test item variants from existing or newly created 
test items, wherein said test item variants can be used as test 
items . 

SUMMARY OF THE INVENTION 

A computerized method and system for creating test items by 
generating variants of a test item model, comprising the steps of 
creating a new test item model by identifying elements of an 
initial test item or a test item model to be variabilized, 
variabilizing the elements thereby creating test item variables, 
indicating values the variables can assume, specifying the 
constraints that define the relationships among the variables, 
and generating test item variants utilizing a simultaneous 
constraint solver . 

The initial test item can be a pre-existing test item or 
test item model, a newly created test item or even a conceptual 
template in the mind of the test item creator. The generated 
test item variants are displayed to the test item creator. The 
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test item creator can store and forward acceptable test item 
variants for later use as test items. Test item models can be 
stored for later use in generating new test item variants. 

In one preferred embodiment of the present invention, a 
frozen test item model can be extended to create its child which 
child model can be modified to generate its own test item 
variants. Moreover, item classification and tracking functions 
are provided. Test item creators can type in test items, edit 
them, import graphics, etc. Items that are created are 
compatible with test delivery software. Item management features 
allow the test developer to track the location and status of an 
item throughout its life cycle. In addition, items may be 
arranged in a searchable and browsable library in terms of 
whatever conceptual frameworks are used in the automatic 
generation and/or analysis of items. The text/graphics of these 
library items can be directly accessible by the item creation 
tools, i.e. the user is able to edit the text of a library item 
to create a new item. 

One preferred embodiment of the present invention was 
written in Visual Basic, as well as the PROLOG IV programming 
language and provides an environment where the user can create a 
test item model or a family of test item models. For example, 
with this embodiment of the present invention, referred to as the 
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"Test Creation Assistant'' or "TCA" , the user may want to create a 
single model for a specific purpose, but could find out that it 
makes sense to have a family of models that have some sort of 
related theme and therefor TCA includes the notion of test model 
families . 

Although preferred embodiments of the present invention are 
described below in detail, it is desired to emphasize that this 
is for the purpose of illustrating and describing the invention, 
and should not be considered as necessarily limiting the 
invention, it being understood that many modifications can be 
made by those skilled in the art while still practicing the 
invention claimed herein. 



5 



BRIEF DESCRIPTIONS OF THE DRAWINGS 



FIGS. 1 - 107 show the computer generated screen displays of 
one preferred embodiment of the present invention. 

FIG. 1 shows the initial Test Creation Assistant window of 
this preferred embodiment and its associated work areas. 
FIG. 2 shows the ''File" menu options, 

FIG. 3 shows the "New family properties" dialog box which 
appears by clicking on "New" in the "File" menu shown in FIG, 2. 

FIG, 4 shows the "Save new family as" dialog box which 
appears by clicking on the "OK" button in the "New family 
properties" dialog box shown in FIG. 3, 

FIG. 5 shows the result of the user entering "NEWMC" as the 
J name of a family of test items in FIG. 4 and saving the choice. 
FIG. 5 shows the TCA Standard Multiple Choice Model Word 
template of this preferred embodiment. 

FIG. 7 shows the stem after the user has entered an initial 
test item. 

FIGS, 8 and 9 show one way to identify elements of the test 
item to be variabalized using a preferred naming convention. 

FIGS. 10-12 show a method for variabalizing and autodefining 
preidentif led test item elements. 



FIG. 13 shows the result of auto-defining the variables. 

FIGS. 14-18 and 24-26 show how string variables may be 
edited in accordance with a preferred embodiment of the 
invention. 

FIGS. 19-20 show how string variables may be exported to 
a file for later use in accordance with a preferred embodiment of 
the invention. 

FIGS. 21 - 23 and 2 7 - 29 show how integer variables may be 
edited in accordance with a preferred embodiment of the 
invention. 

FIGS. 30-44 show how the variable constraints may be 
specified in accordance with a preferred embodiment of the 
invention. 

FIGS. 31-51 show how test item variants may be generated 
in accordance with a preferred embodiment of the invention. 

FIGS. 52 - 56 show how the user can work with generated 
variants in accordance with a preferred embodiment of the 
invention. 

FIGS. 56 - 78 show how the user can work with models and 
accepted variants in accordance with a preferred embodiment of 
the invention. 

FIGS. 79 - 88 shows one way to print variants and the print 
outs generated by the system, after the user clicks on "Print 
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All" in Fig. 19, the print outs showing the variables and 
constraints, test item model, and test item model variants in 
accordance with a preferred embodiment of the invention. 

FIGS. 89 - 91 show screen displays from Quantitative 
Comparison items in accordance with a preferred embodiment of the 
invention. 

FIGS. 92 - 93 show screen displays from Data Sufficiency 
items in accordance with a preferred embodiment of the invention. 

FIGS. 94 - 106 show screen displays for various item types 
in accordance with a preferred embodiment of the invention. 
T\l FIG. 107 show an overview of the computer architecture for 

:j| one preferred embodiment of the present invention. 
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DETAILED SUMMARY OF THE INVENTION 



THE COMPUTER ENVIRONMENT 

The computer system of the present invention was designed so 
5 that people could use it at home as well as on currently 
available desktops at work or notebooks. One preferred 
embodiment works with Microsoft® Windows 95, 98 or NT. This 
embodiment requires Microsoft® WORD 97, PROLOG IV and a Control 
Language Program called TCL 7.6, which is available on the 
10 C:l Internet at http://www.scriptics.com. See the Source Code 

Appendix for further details about this embodiment. The present 
invention is not limited to the foregoing operating systems, 
;.h programming languages and/or software applications, etc. For 
example, an extensible markup language editor could be used in 
15 C;l place of Microsoft® WORD. 

PROLOG IV 

Prolog IV, is a compiled constraint programming language. 
The Prolog IV language allows the programmer to process a wide 
2 0 variety of constraints describing relations over real and 

rational numbers, integers, booleans and lists. The Prolog IV 
constraint solving techniques are based on exact and 
approximation methods. 
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PROLOG IV is distributed by PrologIA, Pare Technologique de 
Luminary - Case 919, 13288 Marseille cedex 09, France. Further 
information about PROLOG IV can currently be found at 
http://prologianet.univ-mrs.fr. PROLOG IV is a programming 
environment . 

CREATING A NEW TEST ITEM 

In accordance with the preferred embodiment as exemplified 

Q by the software application disclosed in the SOURCE CODE 

APPENDICES, the user upon initializing the software application 
is presented with the initial Test Creation Assistant window. 

;1! FIG. 1. 

The initial window is subdivided into several work areas. 
Q One important area is the Microsoft® Word area, which occupies 
most of the left side of the initial window. Also important are 
the three tabbed areas: "Family Overview"; ''Model Workshop''; and 
"Generate Variants" and the two pull down menus: "File" and 
"Help". FIG. 1. 

The Family Overview windows provide information regarding 
Family members and Accepted variants and permits the user to Set 
Attributes and Print a Family member. The Model Workshop tab 
moves the user to areas for creating variabilized test items. 
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The Generate Variants tab permits the user to generate one or 
more test item variants. An item variant is a test item 
automatically generated from an item model, where the item model 
is comprised of constraints, stem, and key. In this tab, item 
5 variants can be displayed, saved or rejected. 

Clicking on "File" menu heading in FIG. 1, opens the pull 
down menu shown on FIG. 2. The menu options are "New'S "Open'', 
"Import Locked Item'', "Print Setup" and "Exit". 
NEW FAMILY PROPERTIES DIALOG BOX 
10 Clicking on "New" brings up the "New family properties" 

Ji^ dialog box. FIG. 3. Using this dialog box the user can select 
1. the particular family properties for the new test item, 
yj Family properties refers to the major properties associated with 
Q a test item. In one preferred embodiment, it refers to the type 
15 Q of "Program" (e.g., GMAT®, GRE®, or SAT®), the "Item type", the 
U "Variant proximity" and whether the test item is to be "generic" 
or "non-generic" . 

In the New family properties dialog box, using a drop-down 
menu, the user can select the "Program": GMAT®, GRE®, or SAT®. 
20 GRE has been selected. FIG. 3. 

In the New family properties dialog box, the user can also 
select the "Item Type" or format of the question, in this 
embodiment: Multiple choice (MC) , Quantitative comparison (QC) , 



or Data sufficiency (DS) . All three options are shown in FIG. 
89; while Multiple choice appears in FIG. 3. 

The user can also select the "Variant proximity" : the 
choices are: Near (variants that are easily recognizable as 
belonging to the same variant family by test developers and test 
takers, this selection is shown in FIG, 3) ; Medium (variants that 
are not easily recognizable as belonging to the same variant 
family by test developers and test takers) ; and Far (variants 
which are difficult to recognize as belonging to the same variant 
family) . Once selected, the user may strive to ensure that 
;1| generated variants are of the identified proximity. 
;.n Finally, the user has the choice of selecting either 

yl ''Generic'' items or "Non-generic" items. Pure items, i.e., test 
ul items in a mathematical setting, are Generic as long as they have 

no distinguishing surface features, such as an unusual figure or 
^::f table. Real items, i.e., test items based on a real -life 

situation, are Generic only if the context is commonly used in 
the text. For example, common context for GMAT includes buying 
and selling questions, profit questions, stock questions, 
interest questions, etc. These would not be Generic items for 
GRE, since the GRE is not aimed at a business school population. 
Generic items for GRE would include simple rate- time-distance 
questions, percent questions, etc. 



Clicking on the ''OK'' button in FIG. 3 brings up the "Save 
new family as'' dialog box shown in FIG. 4. The user then enters 
the name of a family of test items, for example ''NEWMC" and 
clicks on the "Save" action button, the file is saved as a "Model 
5 Doc Files (*$R.doc) and the result is shown in FIG. 5. 

At this point the Program (GRE) , Family (NEW]y[C$R . doc) , 
Attributes (Single multiple choice or SMC; Non generic and Near) , 
and the Active Model (NEWMC$R . doc) are displayed in status bars 
at the bottom of the ETS Test Creation Assistant window. This 
10 information is displayed to the user across all three tabs: 

Family Overview (FIG. 5); Model Workshop (FIG. 13); and Generate 
:]i Variables (FIG. 50) . 
y| MULTIPLE CHOICE MODEL. 

G In the left part of the window in FIG. 5 appears the 

15 Microsoft Word document window with titles: ''TCA Standard 

;::f Multiple Choice Model", "reserved for variants", "stem", and 

"key" . (Also present but not shown are the distractor titles and 
scratch pad, which can be seen in FIG. 6.) The first title will 
depend on the item type that the user chooses in the "New family 
20 properties" dialog box, see for example FIG. 3, The TCA Standard 
Multiple Choice Model Word template as printed out is shown in 
FIG. 6. When the user chooses Quantitative comparison, see FIG. 
89, the result shown in FIG. 90 is the TCA Quantitative 



Comparison Model (see also FIG. 91) , if Data Sufficiency is 
chosen the result shown in FIG. 103 is the TCA Data Sufficiency 
Model (see also FIG. 105) . 

In the right part of the window in FIG. 5 the ''Family 
5 Overview" tab is highlighted. In "Family members" appears an 

icon with a ''Sun" and the name of the variant family, chosen in 
FIG. 4, "MEWMC", and an extension "$R.doc". The "R" identifies 
the test item model as the root model, while the ".doc" 
identifies the file as a WORD document. The "Sun" icon indicates 
10 ^-f that the model is active, that is, an item model that has of yet 
;1J not produce accepted variants and, therefore, is not blocked for 
,ji future changes . 

;jl At the bottom of the "Family members" are two active 

buttons: "Extend" and "Remove". These buttons enable the user 
15 Cj to extend or remove a variant family, respectively. 

Creating an item begins with making entries in the "stem" 
section of the TCA Standard Multiple Choice Model. This is 
preferably done in the "Model Workshop" environment, but may be 
started in the "Family Overview" environment as shown in FIG. 7. 
2 0 As shown in FIG. 7, the user entered the following initial test 
item. 



If John has 5 apples and Mary has 6 apples, how many 
apples do they have together? 
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CREATING A TEST ITEM MODEL 



The present invention provides for the automatic generation 
of test item variants. To do this the user builds a test item 
model. Both the John and Mary initial test item above and an 
existing model can form the basis for building a new test item 
model. A test item model, whatever its size, consists of 
''variables" and ''constraints" . A constraint is a statement 
specifying the relationships among the variables. A variable, in 
turn, indicates an item element that can take on more than one 
value. Variables are defined by the user in terms of type 
(integer, real, string, etc.) as well as the value range those 
variables can take on. Therefore, to build a new model the user 
needs to introduce some variables and define a set of constraints 
for those variables-- the variabilizing process. 

DEFINING VARIABLES BY INDICATING VALUES THE VARIABLES CAN TAKE ON 

In accordance with one preferred embodiment of the present 
invention, there are three ways of starting the variablizing 
process: direct entry of information related to the term to be 
variabilized, such as, name of variable, type, etc.; by pre- 
defining variables in the stem using a naming convention so that 
the system will automatically include the variable and its 
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associated information in the "Variables'' window; or by starting 
with existing test item models or their child models. 

DEFINING VARIABLES DIRECTLY IN VARIABLES WINDOW 
5 The first method is to go over to the Model Workshop tab, 

and under the "Variables window" in the Model Workshop click on 
"Add", a "Create or Change Variable" dialog box will open, 
similar to that shown in FIG. 22, except that the "Variable Name" 
box is empty and the user must type the name in himself /herself 
10 instead of having the system do it automatically as in the second 
fll method. 



J| VARIABILIZING BY USING NAMING CONVENTION AND HIGHLIGHTING 
a The second method is to rename those elements of the initial 

15 test item when in the stem in accordance with the naming 

y convention disclosed below, highlight the text typed in the stem 
section, right click and chose variablize, and the system will 
allow the user to automatically add all capitalized words which 
are highlighted. 

20 

VARIABLE NAMING CONVENTION FOR USE IN AUTO-DEFINING VARIABLES 

When naming variables in the stem for use in auto-defining 
variables, one preferred embodiment of the present invention uses 
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the following conventions. Names of the variables are made up of 
letters and digits; however the first character must be a letter. 
A string variable begins with an "S" ; an integer variable begins 
with an ^^I"; a real variable begins with an "R" ; a fraction 
begins with an ''F'' ; and an untyped variable begins with an ''U" . 
A ^^String Variable'' is a variable that does text substitutions, 
it does not involve mathematical operations. The system just 
searches and replaces one combination of letters, numbers, and/or 
symbols with another. For example, the text substitutions could 
be substituting a male name from a list of male names. On the 
other hand, the text substitutions could be as complex as 
J| substituting a model (with all its variables) from a list of 
yi models, etc. ^Untyped variables" are any variables representing 
Ql a list, a boolean, or whose type is not known at test -item design 

time. These variables need not be defined unless they are 
;:;{ referenced in the stem or in the distractors. Related information 
can be found in the TCA CONSTRAINT LANGUAGE section below. 

IDENTIFYING ELEMENTS OF THE TEST ITEM TO BE VARIABILIZED 

Using the naming conventions above, elements of the test 
item to be variabilized can be identified. The elements are 
identified by typing variable identifiers in place of the 
original test item element. An example of one such 



identification is shown in FIG. 8 and FIG. 9. The user changed 
John to ^^SMaleName'' and Mary to "SFemaleName'' . The ^^S" 
indicating that the variable is a string variable. The user 
replaced the numbers 5 and 6 with "INuml" and ''INum2", 
respectively. The "I" indicating that the variable is an 
integer. The user also replaced ''apples" with ''SItems", another 
string variable. So the stem portion has become: 

''If SMaleName had INuml SItems and SFemaleName had 
INum2 SItems, how many SItems would they have 
together?'' 
FIG. 9. 

The user also changed the key from "Key'' to "I Key" and all 
the distractors from "Distractor_" to "IDistractor_" , because 
he/she is contemplating that all the solutions with be integers. 
FIG. 9. 

At this point, variables can be defined by highlighting the 
terms to be variabilized and then right clicking. FIG. 10. In 
the menu that appears, highlight and click "Variabilize" . The 
result is shown in FIG. 11. 

The "New variable detected" dialog box with words "Auto- 
define variable ...? appears. The system will try to auto-define 
any sequence of letters or digits that begins with a capital 
letter. The system asks the user whether the first word which is 
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capitalized "If should be auto-defined as a variable. The user 
should click on ^^No" , which causes the system to address the next 
capitalized word ''SMaleNames" . FIG. 12. The result of clicking 
on ''Yes" with respect to all words to be variabilized is to 
5 automatically classify the chosen terms in accordance with the 
naming convention. All chosen terms then appear in the 
''Variables'' window as is shown in FIG. 13. Providing the user 
with additional information, not only do the names of the 
variables appear the "Variables" window, but also their 
10 ;f characteristics. For example, string, integer, etc. 



m VARIABILIZING BY USING PRIOR UNFROZEN MODELS OR CHILDREN THEREOF 
i.y The third method is to chose an existing unfrozen model or 

CI child model and edit the existing variables and constraints in 
15 the Model Workshop. This is an important advantage of the 

preferred embodiment of the present invention, as it permits the 
reuse of prior test item models. If the model is frozen, it can 
still be used by extending the model and having the system create 
a "child" model of it; if the model is unfrozen, it can be used 
20 or, again, the system can create a "child'' model of it. In 
either case, the "Variables" window, as well as other 
"constraint" windows, in the Model Workshop are populated with 



variablized terms, ready for modifying through the editing 
process. See, FIG. 55 - FIG. 57, FIG. 71 - FIG. 77, and FIG 81. 

EDITING STRING VARIABLES 

At this point, all the selected variables appear in the 
''Variables" window. Next the variables must be constrained by 
assigning values or expressions to them. One way of doing this, 
is to select a particular variable by making a left mouse button 
click on the chosen variable, then right clicking, which brings 
up the menu shown in FIG. 14, The user selects ''Edit" so as to 
begin the process of providing constraints to the possible values 
or expressions the selected variable can assume. However, as can 
be readily seen from FIG. 14, the system also permits the user to 
perform other useful functions at this stage. 

Selecting "Edit" in FIG. 14 brings up the "Create or Change 
Variable" dialog box of FIG. 15. In accordance with the naming 
convention, as implemented via the auto-define variabilizing 
function of the present invention, and as was indicated in the 
"Variables" window, the variable "SMaleName" in the "Create or 
Change Variable" dialog box has been classified as a "String" 
type variable- SMaleName will be a male name selected from a 
list. The user may at this point, change the variable type, 
notwithstanding the naming convention, by highlighting and 
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clicking on any of the other types listed in the ''Type" menu of 
the ''Create or Change Variable'' dialog box of FIG. 15. 

In this preferred embodiment, "Add to checksum" and 
"Indexed" boxes are selected by default. Selecting the checksum 
5 option helps ensure that a value of a variable will be unique; 

that is, if you want to make sure that all the male names will be 
different. The "Indexed" option enables the user to assign a 
particular order to list SmaleName . FIG. 15. 

Indexing is particular to Strings. Using indexing, if the 
10 Z'l user has an item where the stem reads "a lawyer asked his 

'^l paralegal to call the client " , and he/she wanted that to change 

in some other variant to "a doctor asked his nurse to call a 
ijl patient " . The user would never want to use "lawyer" and 
"patient" or "nurse" together, or "doctor" and "client" or 
15 Cj "paralegal" together. Those three things need to stay together 
^-■^ in the items and indexing permits the user to ensure that they 
do. The user can build sub- strings, so instead of just having 
String values like John or Mary, the user can have value subsets; 
for example, where lawyer, paralegal, client always go together 
20 and doctor, nurse, patient always go together. As shown in FIG. 
16, the user has de-selected "Indexed" and left the remaining 
options alone . 
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CREATING AND IMPORTING STRING VALUES 

Next the user must provide the available String values and 
the present invention provides several ways of doing that. One 
way is simply to click on the "Add" button in Fig. 16. Actually, 
5 in this preferred embodiment, everything on the icon bar of the 
'^Create or Change Variable" dialog box of FIG. 15 (and for that 
matter everything on most of the other icon bars) can also be 
replicated with a right button click. 

Another useful feature of this embodiment is the ability to 
10 save the male name String values (or any other list of String 

'rl: values) for subsequent use with different models. The ''Exporting 
/-J Strings" feature is used to save the list and then the ''Importing 
iji Strings" feature is used to automatically populate the String 
Q values of the variable in the new model. Both ways are discussed 
15 ^-1 below. 

9 Using the "Add" Button 

Click on the "Add" button in the "Create or Change Variable" 
dialog box shown in FIG. 16 and the system provides the user with 
a new dialog box: "Edit string SMaleName" . FIG. 17. The user 
20 then enters a name, for example John, and then clicks "OK". This 
procedure is repeated, this time with the String value equal to 
Tom. FIG. 18. After several more male name String values are 
inputted the result looks like FIG. 19, where the list of male 



names String values all appear, not surprisingly, in the "String 
values'' window. The "Edit" button may be used to edit existing 
string values. 

Using the "Export Strings" and "Import String" Buttons 

The user can utilize the "Export Strings" function to save 
this particular list of String values for reuse with another 
model. The user clicks on the "Export Strings" button shown in 
FIG. 19 resulting in the "Export string to file" dialog box 
appearing. The user can then name the file the String values 
will be saved in (e.g., "male__names" ) and save the file by 
clicking on the "Save" button in FIG. 20. 

In this preferred embodiment, the file is saved into the 
directory "TCS/TCA/ln. The saved Strings can be shared with 
other users. If the user needs "male_names" String values, all 
he/she needs to do is use the "Import Strings" button (e.g., in 
FIG. 16) and choose the appropriate String file found in the 
resulting dialog box. 

FIGS. 24 through 26 show parts of the above process for 
providing the String values for the String variables "SItems" and 
"SFemaleName" . 
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EDITING INTEGER VARIABLES 

Select INuml in the Variables window by making a left mouse 
button click on INuml and then make a right mouse button click to 
open the options menu and ''Edif . Once again the ''Create or 
Change Variable" dialog box will appear. FIG. 21. In accordance 
with the naming convention and the auto-define variables 
function, ''INuml'' has been assigned the type "Integer" . In the 
dialog box of FIG. 21 can be found the "Add to checksum" box 
discussed with respect to String variables and a new box entitled 
"Independent". FIG. 21. Checking the "Independent" box ensures 
that the value of the variable will fall into the range of values 
defined for that variable. If an independent variable (e.g., 
INuml in FIG. 22) is not assigned a value in a constraint, a 
value from the defined range of values (shown in the FROM/TO/BY 
windows) is chosen at random. If an independent variable (e.g., 
INuml in FIG. 22) is assigned a value in a constraint (e.g., 
"INuml =/= INum2" (FIG. 49)), the value chosen for the 
independent variable will still fall within the defined range of 
values (shown in the FROM/TO/BY windows) chosen at random, but 
the actual value chosen for the variable will also be required to 
satisfy the constraint. 

When "Independent" is checked a default range of from 1 (its 
lowest value) to 100 (it largest value) by 1 (or in increments of 



1) appears. That is, at this point, INuml can have the following 
values: 1,2,3,.,., 10 0 . FIG. 22. As shown in FIG. 23, the range 
has been change to from 2 to 2 6 by 3, and therefore variable 
INuml can have the following values: 2 , 5 , 8 , 26 . 

In a like manner, the range of values of independent integer 
"INum2" has been chosen by the user to be 2 to 27 by 5. FIG. 27. 
Finally, as IKey represents the answer, the user leaves the 
''Independent" box unchecked as its value will depend upon the 
values of the variables. FIGS. 28 and 29. 

SPECIFYING THE CONSTRAINTS 

To define relations for determining a value of '"IKey" the 
user can click on "Add'' button in the ''Variation Constraints" 
window in FIG. 29, This will bring up the "Create or Change 
Constraints" dialog box. FIG. 30. This dialog box is divided 
into three areas. The first entitled "Constraint" is the box 
wherein variables are constrained. The second comprises three 
work environments entitled "Operators" , "Variables" , and 
"Functions" . Clicking on the title/tab activates the chosen 
environment. Finally, there is a section entitled "Comment" 
which allows the user to provide comments documenting the 
particular constraint for use by the current user or another user 
at some later time. 



Operators 

The first tab in the box entitled "Operators'' appears in 
bold indicating that the buttons associated with this tab are 
available to the user. That is, clicking on a button places its 
operator in the ''Constraint" box. The buttons in the "Operators" 
environment appear in FIG. 3 0 and comprise mathematical 
operators: =, %, >, <, >=, <=, if, then, else, elseif, 

0 , etc . 
Variables 

Clicking on the "Variables" tab, activates the ''Variables" 
environment, and allows the user to enter into the "Constraint" 
box all currently identified variables. FIG. 31. The user just 
highlights the variable and clicks on the "Insert" button. 
Functions 

Clicking on the "Functions" tab, activates the "Functions" 
environment, and allows the user to enter into the "Constraint" 
box all TCA library functions. FIG. 32. The user just 
highlights the variable and clicks on the "Insert" button. 
Moreover, clicking on a function brings the function to the top 
box of the "Functions" environment and provides the user with a 
definition of the function immediately below it. See, for 
example, FIG. 39. 
Constraining "IKey" 



The user clicks on the "Variables'' tab and selects ''Ikey" . 
FIG. 33, Clicking on the "Insert" button causes the system of 
the present invention to put "IKey'' at the current cursor 
location in the "Constraint'' box, FIG. 34. Clicking on the 
"Operators" tab and then clicking on the "=" operator button 
results in the start of a constraint, namely: "Ikey=" . FIG, 35, 
Going back and forth from "Variables" to "Operators" and 
inserting INuml, , and INum2 results in FIG, 36. The system 
allows the direct entry of the constraint in the "Constraint" 
box, however, providing the ability to pick and choose by 
clicking facilitates constraint generation, by among other 
things, reducing typographical errors. 
Exporting and Importing Constraints 

The user can export and import variation constraints in a 
fashion similar to exporting and importing strings. The "Export 
Constraints" and "Import Constraints" buttons in the "Model 
Workshop" are used. FIG. 37. The only difference is that when 
the user exports or imports constraints the system necessarily 
exports /imports variables, variable constraints, and associated 
comments. Clicking on the "Print Constraints" button, FIG. 37, 
in one embodiment, prints out the constraints. 
Constraining the Distractors 
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Multiple choice tests items are designed to have several 
responses from which the test taker will choose the correct 
answer. The correct answer is the key or in this example "IKey" . 
The other responses are wrong answers or distractors and are 
5 called ''IDistractor_'' . The user defines as many distractors as 
the test item calls for, in this example four (4) distractors. 
To add distractor constraints, the user can click the ''Add" in 
"Distractor Constraints" window, FIG. 38, and the "Create or 
Change Constraints" dialog box will appear. FIG. 39. 
10 Q To add an expression for distractor "IDistractorl" , the user 

'^l can either directly type it in the "Constraint" window/box or 
^IJ insert it by going to the "Functions" tab, selecting a function 
.|l from the list, and inserting it by clicking on the "Insert" 
Q button. When a function is selected, a useful description of the 
15 CI function is displayed to the user. FIG. 39. Variables can be 
□ inserted into functions, for example, "INuml" and "INum2" into 
^^minO". See FIGS. 39-41. Clicking on the ^^OK" button in the 
"Create or Change Constraints" dialog box finishes defining the 
constraint for the time being and all the constrained distractors 
2 0 appear in the "Distractor Constraints" window of the Model 
Workshop. See, e.g., FIG. 42. 
Testing the Constraints 
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The systems permits the user to test the constraints by 
testing selected or all variables, variation (variable) 
constraints, and distractor constraints. The user checks off all 
the items to be tested and depending on the circumstances clicks 
on the "Test'' buttons on the icon bar at the bottom of the 
appropriate Workshop window or the "Test All" button to the right 
of those windows. The ability to chose particular items to be 
tested is very helpful in locating the source of any problem. 
FIG. 42. After TCA finishes testing all checked variables and 
constraints in FIG. 42, a "Test Result'' window appears. FIG. 43. 
The "Test Result" for FIG. 42 was "Variable IDistractor4 is 
underconstrainedi " In fact, it had not been constrained. After 
constraining IDistractor4 and clicking on the "Test All" button 
appears the next "Test Result". FIG. 44. This time TCA tells 
the user that the constraints "Looks Good!". If the constraints 
"Looks Good!" the next step is to click on Generate Variants" tab 
so as to be able to use TCA to automatically generate test item 
variants based on the model developed in the Model Workshop. 
FIG. 45. 

GENERATING TEST ITEM VARIANTS 

To generate variants all the user needs to do is enter the 
number of variants to be generated in the "Number" box and click 
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on the "Generate" button. FIG, 45. The user can also adjust the 
''Prolog randomization" . The generated variants will appear in 
the ''Variants'' window. In this case the system was requested to 
generate two (2) variants from family model "NEW]y[C$R.DOC" , The 
variants generated from this model have names NEWMC$R1 . doc and 
NEWMC$R2 . doc . That is, family model name variant number 1 and 
number 2. FIG. 46. Selecting a variant in the "Variants" window 
causes the variant to be displayed in the Microsoft® WORD window. 
Note that at least three of the distractors for test item 
NEWMC$Rl.doc equal the same value, namely, 6. Therefore, as 
initially constrained the distractors in this model can 
simultaneously have the same value, which is wrong. Therefore, 
the user will need to change the constraints to eliminate this 
possibility. 

If based upon a review of the generated variants the user 
wishes to modify the constraints, he/she need only click on the 
"Model Workshop" tab. If the user does so, a warning appears to 
the effect that variants on tab 3 (the "Generate Variants" tab) 
will be deleted if not saved before changing the model. FIG. 47. 
FIG. 48 shows part of the process of adding a new constraint in 
an attempt to resolve the distractor problem. The new constraint 
is that INuml cannot equal INum2 . Adding this constraint and 
then testing results in a "Looks Good". FIG. 49. 
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FIGS. 50 - 51 show the result of generating 2 variants from 
the new model. It appears that the distractor problem has been 
fixed. 

WORKING WITH GENERATED VARIANTS AND GENERATING NEW MODELS 
5 ACCEPTING VARIANTS 

If the user is satisfied with one or more generated test 
item variants, the variants may be accepted. Selecting the 
variant "NEWMC$R3 . doc" and clicking on the "Accept" button in 
FIG. 52 leads to FIG. 53 where a dialog box entitled ''Confirm" 
10 "!f appears and the user is given one more chance to accept the 

III variant or not. Since the user chose to accept the variant, it 

no longer appears in the "Variants" window of the "Generate 
ul Variants" tab. See FIG. 54. 
Q DEFERRING AND DISCARDING VARIANTS 
15 If the user does not "like" a variant, the variant can 

either be deferred by selecting and clicking on the "Defer" 
button, or discarded by selecting and clicking on the "Discard" 
button. FIG. 54. In deferring a variant, this preferred 
embodiment of TCA does not store the variant's check sum value, 
2 0 therefore, deferred variants could be generated again. On the 
other hand, discarded variant check sums are stored to ensure 
that they will not be regenerated in the future. 
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CREATING NEW VARIANT MODELS FROM A GENERATED VARIANT 

To create a new variant model (new children of the active 
model) from a particular variant, select the variant in the 
''Variants" window and click on the "Create Mdl . " (Create Model) 
button on the icon bar located at the bottom of this window. 
FIG, 54. A dialog box entitled "Confirm" will appear, the user 
clicks on the "Yes" button, FIG. 54, to create a new model. The 
new model creation is confirmed by a dialog box entitled "Model 
Created". FIG. 56. Thus confirming that the variant has been 
copied with a new name . The name of the new model appears in the 
"Model Created" dialog box. In this case, the new model is named 
"NEWMC$RA. doc" . The "R" means that the model is a root model, 
the "A" at the end of the name implies that it is a child of the 
model "NEWMC$R.doc" . FIG. 56. In this way, the variables and the 
constraints of the previous model are preserved, so the user does 
not have to go in and start variabilizing from the beginning. 

ACCEPTED VARIANTS AND NEW FAMILY MODELS 

If the user clicks on the "Family Overview" tab, FIG. 57, 
"NEWMC$RA.doc" appears in the "Family members" window. A sun 
icon next to this name indicates that the model is active. The 
"snowflake" icon to "NEWMC$R. doc" indicates that this model is 
"frozen" . As soon as at least one item variant generated from an 
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item model is accepted, the item model is frozen. A frozen item 
model can be viewed and used to generate more item variables and 
unfrozen child models, but the model is blocked to future 
changes. Finally, the accepted variant ''NEW]y[C$R3 . doc'' appears in 
the ^'Accepted variants'' window, FIG. 57. 

WORKING WITH MODELS AND ACCEPTED VARIANTS 

To begin working with the new model ''NEWMC$RA. doc" click on 
the name and the model will appear in Word® window. FIG. 58. 
Click on ''Set Attributes" button in FIG. 58 brings up the ''Family 
7I: Attributes" dialog box. FIG. 59. The user has the option of 
choosing either "Generic" or "Non-generic" . Variants are 
considered "generic variants" if they are very familiar in terms 
of structure and content, otherwise variants are called "non- 
generic variants" . The user also has the option of choosing the 
"Variant proximity". As can be seen in FIG. 6 0 the proximity can 
be "Near", "Medium" or "Far". Clicking "OK" after making the 
appropriate selections in the "Family Attributes" box associates 
the selections with the model. 

To "extend" (make a copy) or remove a "frozen" model or "un- 
frozen" model, the user selects the item, right mouse-button 
clicks, and selects "Extend" or "Remove". FIG. 61. The same 
could be done by using buttons "Extend" and "Remove" that are 



located on the bar at the bottom of the "Family members" window. 
FIGS, 61-62. 

EDITING THE PROFILE OF A VARIANT 
5 To edit or copy the profile of an accepted variant, select 

the variant and click on the ''Edit Profile" or "Copy Profile" 
button as appropriate. They are located on the bar at the bottom 
of "Accepted variants" window. FIG, 63. Clicking on "Edit 
Profile" brings up the "Profile of variant [name of variant] " 
10 O dialog box. FIG. 64. Clicking on the arrow next to the 

^^Domain:" window in FIG. 64 brings down the selection of domains: 
% Arithmetic, Algebra, Data Analysis, or Geometry. FIG. 65. 
11 Clicking on the arrow next to the "Target template:" window in 
r;i FIG. 64 brings down the selection of targets: "CBT" for computer 
15 Q based testing or ^^PPT" for paper and pencil testing. FIG. 66. 

The user can also select either "Pure" or "Real" shown for 
example in FIG. 66. A Pure test item is one in a mathematical 
setting. A Real test item is one that is based on a real-life 
situation. The user can also select Route to TCS (ETS' Test 
2 0 Creation System) shown for example in FIG. 66. ETS' Test 

Creation System is disclosed in U.S. Patent No. 6,000,945, which 
is hereby fully incorporated by reference herein. 
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The GRE Difficulty Portion of the Profile of a Variant Window 

The ^'GRE Difficulty" portion of the Profile of variant 
window shown in FIG. 67, for example, has several components. 
Clicking on the arrow next to the "Computation:" window, brings 
down the following selection which denotes the type of numbers 
used in the test item: Integers, Decimal/fractions, Radicals, or 
Not applicable. FIG. 68. In the same fashion, the "Cognition:" 
window provides selections for denoting the sort of process the 
test item requires the test taker to go through to arrive at the 
answer, namely: Procedural, Conceptual, or Higher order 
thinking. FIG. 69. The "Concept" window provides selections for 
denoting the basic concepts tested by the item, namely: 
Probability, Percent of a percent. Percent change. Linear 
inequality, or Not applicable. FIG. 70. "Adjust the slide to 
estimated difficulty:" allows the user to denote his or her 
opinion of the difficulty of the variant. See, for example, FIG. 
70. The "Key:" window allows the user to denote the correct 
answer. Finally, the "Predicted Difficulty" or IRT b measure is 
calculated from other entries in the window {e.g., whether the 
item is arithmetic or algebra) . 
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WORKING WITH FAMILY MEMBERS 

Back at the ^'Family Overview^' window, FIG. 71, by selecting 
the "frozen model" "NEWMC$R. doc" , right mouse-button clicking, 
and selecting "Extend", the user can extend the "NEWMC$R. doc" . 
In response to selecting "Extend", the "Confirm" window pops up, 
FIG. 72 and clicking on "Yes" extends the model. New active 
model "NEWC$RB.doc" then appears in the "Family members" window. 
FIG. 73. 

Using a New Active Model to Generate Far Variants 
Q The new model is immediately available for the user, 

i^jj Clicking on the Model Workshop tab for "NEWC$RB . doc" brings the 
■'IJ user to a place where he or she can modify the model. For 

example, the user could replace the stem: 
r| "If SMaleName had INuml SItems and SFemaleName had 

Q INum2 SItems, how many SItems would they have 

Q together?" ; 

with "SStem"; add "SStem" as a new variable; and add 

"If SMaleName had INuml SItems and SFemaleName had 
INum2 SItems, how many SItems would they have 
together?" ; 

as a String value for "SStem". See FIG. 73A. The user could 
also add other values for "SStem", for example, 

"INuml + INum2 = ?" . 



FIG. 73B. Thus, this preferred embodiment of the present 
invention allows the user to easily generate far variants 
(variants that are very different from one another) from this new 
stem by going to ^^Generate Variants^', requesting 2 variants, FIG. 
73D, and clicking on the "Generate'' button. Thereby generating 
new variants "NEWMC$RB3 . doc'\ FIG. 73D and "NEWMC$RB4 . doC', FIG, 
73E. 

Creating Still More Models 

Preferred embodiments of the present invention permit the 
user to make a child model from the "NEWC$RB . doc'' model of FIG. 
73, that is, to extend it. The user selects ''NEWC$RB . doc" , 
clicks on the "Extend" button, and then enters "Yes" in the 
"Confirm" window, FIG. 74. New active model "NEWC$RBA, doc" 
appears. FIG. 75. Left button click to select this model, then 
right mouse button click to extend it or remove it. FIG. 75. To 
make a child model from new model "NEWC$RA. doc" , repeat the above 
procedure. New active model "NEWC$RAA. doc" appears. The "AA" 
stands for a child of a child of the root model. See, FIGS. 76 - 
77, 

The constraints for any of the active models that are 
displayed in the "Family members" window can be changed. To 
change the constraints, select an active model in the "Family 
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members'' window, click on tab Model Workshop, left button click 
to select a constraint, and then right button click to get the 
constraint option. FIG. 78. 

5 

PRINT OPTIONS 

To print accepted variants click on tab "Family Overview" 
and then click on button ''Print All" in FIG. 79. FIGS. 80A, BOB 
and 80C is the result. It is a print out of the variables and 
10 n constraints for model ''NEWMC$R" . Selecting the model ''NEWMC$RA" 
as the active model and in the Model Workshop clicking on the 
''Print Constraints" button in FIG. 81, results in a print out of 
;jl the variables and constraints for model ''NEWMC$RA" . See, FIGS. 
Q 82A, 82B, and 82C. 
15 CI To print a model without constraints click on the ''Family 

^ Overview" tab and select a model, for example NEWMC$R.doc. In 
the Microsoft® WORD window entitled "NEWMC$R . doc" , select File 
and Print or just click on print button. The result is a print 
out of model "NEWMC$R. doc" without constraints. See FIG. 83. 
20 To print one of the accepted variants from a particular 

model, click on "Family Overview" tab, select a model, for 
example "NEWMC$R . doc" . In "Accepted variants" window, select one 
or more variants, for example "NEWMC$R3 . doc" , "NEWMC$R4 . doc" , 
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etc.. In the Microsoft® WORD portion for each variant print out 
the document. The test item variants appear in FIGS. 84-88. 

GRE QUANTITATIVE COMPARISON ITEMS 

To create a model for GRE Quantitative comparison items, the 
user starts as shown in FIGS. 1-3. However, instead of keeping 
Multiple choice as an item choice, "Quantitative comparision^' is 
selected. FIG. 89. ^^Non-generic" and "Near" are also chosen is 
the example to be discussed. After saving this new family as 
"NEWQC" the result is FIG. 90. 

In the Microsoft® WORD document appears the title "TCA 
Quantitave Comparison Model"; there are also sections entitled 
"reserved for variants", "stem", "column A", and ^^column B" . In 
the right part of the window you will see "Family Overview" tab 
highlighted. In "Family members" you will see an icon with a sun 
and the name of the chosen variant, "NEWQC" , next to it. The 
variant family name will have an extension "$R.doc". The "sun" 
icon again indicates that the model is active. In the "Family 
members" window appear two highlighted buttons: "Extend" and 
"Remove" . These buttons enable the user to extend or remove the 
variant family, respectively. At the bottom of the "ETS Test 
Creation Assistant" window, you will see a toolbar with following 
titles: "Program -GRE", "Family -NEWQC$R . doc" , "Attributes - QC" , 
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"Mon generic", "Near", "Active Model . . . "NEWQC$R. doc" . FIG. 
90. 

FIG. 91 is a print out of "NEWQC$R. doc" . The idea of a QC 
item is to compare values in columns A and B. FIG. 91. 

GMAT DATA SUFFICIENCY ITEMS 

To create a model for GMAT Data Sufficiency items the 
approach is generally the same as with the other item types 
taking into account the concept behind the item type. See FIGS. 
92 - 93. 

FURTHER EXAMPLES OF ITEM MODELS 

See FIGS. 94 - 106B for further examples of item models. 
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PROLOG SIMULTANEOUS CONSTRAINT SOLVER 

Preferred embodiments of the present invention use PROLOG as 
its simultaneous constraint solver. Details of one preferred 
embodiment appear in the PROLOG SOURCE CODE APPENDIX, Brief 
descriptions of the TCA Prolog (and Prolog-related) files are 
provided below, 
HLP4lib.p4 

This file provides a library of Prolog-predicates for use in 
solving mathematical constraints. For example, it provides a 
Prolog predicate gcd(GCD, A, B) returns the GCD of two integers A 
and B. This file provides a library of Prolog IV accessory 
relations useful in high-level API. 
PrlgExpr . 1 

This file provides the lexical specification for the Prolog- 
expression scanner. Using this file, an appropriate scanner is 
generated. The scanner breaks the mathematical constraints into 
; individual words and operators (called tokens) which are further 
used by the Prolog-expression parser. 
PrlgExpr .y 

This file provides the syntactic specification for the 
Prolog-expression parser. The file PrlgExpr. y provides the BNF- 
specif ication from which the parser-code is generated. While 
PrlgExpr. y is "almost" a parser, it contains, strictly speaking. 



a specification to generate a parser. Therefore, using this 
file, an appropriate parser is generated. The parser accepts the 
tokens from the scanner, and recognizes the syntactic patterns of 
mathematical constraints (or parses mathematical constraints or 
computes a parse-structure for mathematical constraints) . Having 
recognized the syntactic patterns, it transforms the mathematical 
constraints into appropriate Prolog clauses, and calls Prolog IV 
to solve those clauses. 
hlP4API.h 

This file provides a specification for API access to the 
mathematical constraints-solver, Prolog IV. Using this 
specification, other programs can access the constraints-solver 
to solve mathematical constraints. 
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TCA CONSTRAINT LANGUAGE 



TCA uses a high-level language derived from Prolog and 
Algebra to write mathematical constraints. This section 
describes the language and provides some example mathematical 
constraints . 

The TCA constraint language is intended to help the test 
developers in writing models for math items to be cloned. As 
such, it is a language very similar to the test developers' 
language of choice: the mathematical notation to write algebrai 
equations. It provides a suite of predefined high-level 
functions to choose from, high-level set operators (e.g. 
membership/iteration over a continuous range or a discrete set) 
and additional operators (e.g. and, or) to combine the 
constraints in the desired fashion. 

The TCA constraint language differs from procedural 
languages (e.g. C, Fortran) principally in that it is a 
goal -oriented language, that is users need specify only the 
constraints to be solved, and not how to solve them. In 
addition, the TCA constraint language has (almost) no 
program-flow control mechanisms (e.g., no goto's, no while loop) 
Program-flow is controlled by the constraint-solver. Further, c 
expected from a mathematical constraint -solver, it is 



constraint -order independent (e.g. X= 2, Y= X+2 . can equally well 
be written as: Y= X+ 2, X= 2. ) . 
NOTATIONAL CONVENTION 

Solutions follow the arrow (=>) after the constraint. 

Item* represents 0 or more instances of Item. 

Item+ represents 1 or more instances of Item, 

Item? represents 0 or 1 instance of Item. 

func/n represents a function with n arguments, for example, 
max/2 represents the function max with two arguments (e.g., 
max(4, 7)), while max/l represents the function max with 1 
argument (e.g. max ([4, 7])). 

In describing the arguments to a function, the notation 

+Arg is used to indicate that the value of the Arg must be 
given (i.e., Arg is an input argument), and 

-Arg to indicate that the value of the given Arg is set by 
the function (i.e., Arg is an output argument) . A simple 

Arg (without + or -) indicates that one can use the argument 
with input or output parameter. 
TCA CONSTRAINT LANGUAGE IN DETAIL 

The TCA constraint language (often referred to herein as the 
language) is syntactically based on conventional mathematical 
notation system, with some additional syntactic constructs to 
combine multiple constraints in various ways (e.g., conjunction. 



disjunction, if -then-else) and to supply some low-level details 
often hidden in mathematical notations (e.g., type, precision, 
stepsize for iteration) . Note that the TCA constraint language 
is case-sensitive; e.g., Xvar is different from xvar. 

The TCA constraint solver can solve linear constraints and a 
large class of nonlinear constraints. The user need specify only 
the constraints to be solved, and not how to solve them. The TCA 
returns all the solutions to the specified constraints. Further, 
all the constraints and functions are relations which have 
minimal input/output directional restrictions; i.e., one can use 
the same argument in a function to provide a known parameter and 
to compute an unknown value. For example, one can use the same 
constraint Z*Z= X*X+ Y*Y in multiple ways: 

Given X (:3) and Y (:4), to compute the value of Z; i.e.: 

X= 3, Y= 4, Z*Z= X*X+ Y*Y. => {Z: 5; Z: -5}. 

Given Z(:5), to compute the possible values for X and Y; 

i.e.: 5*5= X*X+ Y*Y, int (X, Y) . => {X: 3, Y: 4; X: 4, Y: 

3}. 

Given Z (:5) and X (:3), compute the value of Y; i.e.: 5*5 

= 3*3+ Y*Y. => {Y: 4} . 
The constraints in the language are specified using a combination 
of the representational devices offered by the language: basic 



elements, type specifications, set specification, algebraic 
constraints, logical combinations. 
BASIC ELEMENTS 

Basic elements are the basic objects of the language. These 
elements are later referred, in general, as the terms. 

1. Constants, 

a) Numbers: 4, 10, -4, 5.6, -6.7. 

b) Symbolic number: pi. 

c) Symbolic constants (atom) : Symbolic constant -names must start 
with a lowercase letter. For example, countVar, accountant. Any 
alphanumeric symbol that starts with a lowercase letter is 
considered a constant. Symbolic constants may not occur in an 
algebraic constraints: "X = 5 + accountant" is invalid. 

2 . Variables . 

Variable-names must start with an uppercase letter: X, Xin, 
Yout . Note that case (uppercase, lowercase) is important. For 
example, X is a variable whereas x is a constant. 

A special variable, called anonymous variable, may also be 
used. An anonymous variable is written as: . An anonymous 

variable acts like a placeholder, as a don't-care variable. Each 
anonymous variable, even when used multiple times within the same 
constraint, is distinct and one may not refer to it. For 
example, function divmod(N, D) returns a list: [N div D, N mod 
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D] . However, in case one is not interested in, say, the 
mod-result (i.e. the second member of the list), one could write: 
[Div, _ ]= divmod(N, D) , 
3 . Lists . 

A list of variables, constants, other lists using the 
format: [ elements* ], e.g.: [] , [a, b, c] , [1, 2, 4, 7], [1, 

[2, 3, 4], C, 7]. One can access the elements of the list using 
the notation: ListMame [ Indexl [, Index2 [, Index3 ...]] ]. 
Note that the first element of the list is indexed 1, second 
element is indexed 2, and so on. Multiple indices are used for 
multilayered lists; lists containing lists as elements: [[a, b] , 

[c, d] ] . Multilayered lists can be used to represent tables. 
Some constraints involving lists and list -elements and their 
solutions are shown below: 



L= 


[1, 


3, 5, 


7] 


, x= 


L[2] 






= > 


X: 


3 . 




L= 


[[1, 


3] , 


[5, 


7] , 


[9, 


11] ] , X= L[2] 




= > 


X: 


[5, 


7] 


L= 


[[1, 


3] , 


[5, 


7] , 


[9, 


11] ] , X= L[2, 


1] . 


= > 


X: 


5. 




L= 


[[1, 


3] , 


[5, 


7] , 


[9, 


11] ] , X= L[2, 


2] . 


= > 


X: 


7 . 




L= 


[ [a. 


[b. 


c]] 


, [d. 


[e. 


f] ] ] ,X= L[2, 


2] . 


= > 


X: 


[e. 


f] 


L= 


[ [a, 


[b, 


c]] 


, [d, 


[e, 


f] ] ] ,X= L[2, 


2, 1] . 


= > 


X: 


e . 





4. Functions. 
In accordance with the present invention, functions 
predefined in the constraint language can be used. General format 
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for a function-call is: function-name (args* ) . For example, 
abs (X) or mean (A, B) or median ( [1 , 4 , 3 , 7 , 9]). 
Mote that the functions return values of the types indicated 
below. The functions are valid only when their return-values are 
in the appropriate context. That is, functions returning numbers 
must be in the context of the algebraic expressions (e.g. 
(assuming X is a variable of type number) : X= sqrt(25)); 
functions returning lists must be in the context of the list 
expressions (e.g. (assuming L is a variable of type list) : L= 
sort ( [1,7,5,3,2] ) ; functions returning symbols must be in the 
context of the symbol expressions (e.g. even(4)= true.). 
The predefined functions for one preferred embodiment are listed 
below with the following notational convention: 

The return-type of a function is indicated as: => 
Return- Type . 

Names of the function -arguments of type integer start 
with I; 

Names of the function -arguments of type real start with 

R; 

Names of the function- arguments of type number start 
with N; 

Names of the function -arguments of type 
lists-containing-numbers start with NL; 
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Names of the function- arguments of type list 
(containing any kind of elements) start with L) . 
The predefined functions include: 

max(+Nl, +N2) (=> Number) Returns the maximum of 
numbers Nl and N2 e.g. X= max (4, -5) . 

max(+NList) (=> Number) Returns the maximum of 

a list of numbers e.g. X= max ([2, sqrt(9)]). 

min(+Nl, +N2) (=> Number) Returns the minimum of 
numbers Nl and N2 e.g. X= min(4, -5) . 

min(+NList) (=> Number) Returns the minimum of a 

list of numbers e.g. X= min([2, sqrt(9), 2^2]). 

mean(+Nl, +N2) (=> Number) Returns the mean of numbers 
Nl and N2 e.g. X= mean(4, sqrt(9)). 

Mean(+NList) (=> Number) Returns the mean of a list 
of numbers e.g. X= mean ([2, sqrt(9), 2^2]). 

median (+NList) {=> Number) Returns the median of a list 
of numbers e.g. X= median ([2, sqrt(9), -4, 7]). 

gcd(+INl, +IN2) (=> Integer) Returns the gcd of integers 
INI and IN2 e.g. X= gcd(4, 6). 

lcm(+INl, +IN2) (=> Integer) Returns the 1cm of integers 
INI and IN2 e.g. X= 1cm (4, 6) . 

sqrt (N) (=> Number) Returns the positive 

square-root of (positive number) N e.g. X= sqrt(20). 



cubert (N) (=> Number) Returns the cube-root of 

(positive number) N e.g. X= cubert(20). 

reverse (+List) (=> List) Returns the reversed List e.g. 
X= reverse( [1,2,3,7,5] ) . 

sort(+NList) (=> List) Returns the list of numbers 
sorted in numerically ascending order e.g. X= 
sort ( [1,2,5,3] ) . 

permute (+List) (=> List) Returns the various 
permutations of the given List e.g. X= permute ( [1 , 2 , 3] ) . 

select_r_of__n_ordered(IN, IR) { = > Integer) Returns no. 
of ordered subsets of size IR from the set of size IN. 

select__r_of_n (IN, IR) ( = > Integer) Returns no. of 
unordered subsets of size IR from the set of size IN. 

random 0 ( = > Integer) Returns a randomly 

generated integer e.g. X= random () . 

random ( +Li s t ) { = > Same - as - the - Given- Li st - El ement ) 
Returns a random element from the given list e.g. X= 
random ( [a, 2 . 5 , 6 , c] ) . 

random ( + I]y[ax) ( = > Integer) Returns a random integer 
between 1 through (positive integer) IMax e.g. X= random(7). 

even(+IN) (=> true) Returns literal constant true 

if IN is an even integer e.g. even (10)= true. 
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odd(+IN) (=> true) Returns literal constant true 

if IN is an odd integer e.g. odd(ll)= true. 

is___perfect_square ( + IN) ( = > true) Returns literal 
constant true if IN is a perfect square e.g. 
perf ect_square (16) = true. 

isnot_perfect_square (+IN) (=> true) Returns literal 

constant true if IN is not a perfect square e.g. 
isnot_perf ect_square (17) = true. 

is_perfect_cube(+IN) (=> true) Returns literal 

constant true if IN is a perfect cube e.g. 
perf ect_square (64) = true. 

isnot_perfect_cube (+IN) (=> true) Returns literal 
constant true if IN is not a perfect cube e.g. 
isnot_perf ect_square (25) = true. 

is_prime (+IN) (=> true) Returns literal constant true 
if IN is a prime integer e.g. is_prime (11) = true. 

isnot_prime (+IN) (=> true) Returns literal constant 

true if IN is not a prime integer e.g. isnot__prime (10) = 
true . 

5. Algebraic Expressions (referred to as: AlgExpr) . 
Expressions can be built by combining other algebraic 
expressions (e.g. numbers, variables, functions) using the 
arithmetic operators. Valid operations include: 
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+ " (addition) : AlgExpr + AlgExpr, e.g. A + B, or 4 
+ C, or sqrt (16) +7 . 

(subtraction) : AlgExpr - AlgExpr, e.g. A - or 
4 - C, or sqrt (16) -7 . 

''Unary -" (unary negation) : - AlgExpr, e.g. -B, or 

-7 . 

(multiplication) : AlgExpr * AlgExpr, e.g. A * B, 
or 4 * C, or sqrt (16) *7. 

'V" (division) : AlgExpr / AlgExpr, e.g. A / B, or 4 / 
C, or sqrt (16) /7 . 

(modulo) : AlgExpr % AlgExpr, e.g. A%B, or 4% 
C, or sqrt (16) %7 . 

(quotient) : AlgExpr \ AlgExpr, e.g. A\B, or 4\ 
C, or sqrt (16) \7 . 

(exponentiation) : AlgExpr ^ AlgExpr, e.g. A ^ B, 
or 4 ^ C, or sqrt (16) ^7. 

'M" (factorial): AlgExpr!, e.g. A!, or 41. 
"I" (abs) : I AlgExpr |, e.g. |A - 10|, or 
I sqrt (16) -7 I . 

The precedencies of the arithmetic operators are as follows 
(higher precedence operators are specified before the lower 
precedence once): I; ^; - (unary negation); % & \; /; * ; + & - 
(subtraction) ; | ... | . 
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CONSTRAINT SPECIFICATION 

1. Type Constraint Specification. 
These constraints specify the type of the variables in the 
constraint. The default variable type is ''real". 



''int (VarLst) " 
"real (VarLst) " 
''fraction (VarLst) 
"symbol (VarLst) " 
"list (VarLst) " 
"ongrid (Var) " 



e.g. : int (X) , int (X, Y) . 
e.g.: real (Y) , real (X, Y) . 
e.g.: fraction(X), fraction(Y, Z) . 
e.g.: symbol (X) , symbol (Y, Z) . 
e.g. : list (X) , list (X, Y) . 
Specifies that the value of the given 
variable must be an integral multiple of 
its precision. [This is the default 
behavior of the variables , ] 
e.g.: ongrid (X) . 

Specifies that the value of the given 
variable need not be an integral 
multiple of its precision, 
e.g.: of f grid (X) . 

2. Optimizable-Relation Specification. 
A user may help the constraint -solving process by 
identifying the optimizable relations. Such relations must be 
valid for the entire constraint (i.e., they may not be a part of 
a disjunctive clause) , and they may be moved around by the 



"of f grid (Var) " 



53 



constraint-solver without any logical incorrectness, usually to 
the start of the clause. 

The devices to identify such relations include: 

"eq_vars (Vars) " Variables in the given 

comma- separated- list must be 
equal to each other, 
e.g.: eq_vars (X, Z) . 

''neq_vars (Vars) " Variables in the given 

comma- separated- list may not 
be equal to each other, 
e.g.: neq_vars(X, Y, Z) . 

^^neq_varvals (Var, Vals)'' The given variable may not be 

equal to any of the values 
specified in the 
comma-separated-list . 
e.g.: neq_varvals (X, 2, 5, 7). 

^^optimizable_rel (Relation) The specified Relation is 

optimizable. This is a 
generalization of the special 
optimizations presented above, 
e.g. : optimizable_rel (X=/=5) . 
Note that neq_vars (X, Y) (and, similarly, eq_vars(X,Y) ), while 
semantically equivalent to X-/=Y, is operationally different from 
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X=/=Y in that the constraint -solver optimizes such declarations 
(which it cannot do in case of declarations such as: X=/=Y or 
X=Y) . 

3. Precision Specification. 

Constraints are solved with certain precision. The default 
precision is: 0.01 for reals, 1 for integers. Nonlinear 
constraints are solved by enumerating through the potential 
solut ion- interval . A variable may assume a value which must be 
an integer multiple of its precision. 

Precision for a variable can be changed individually by 
using the following construct for the variable in the 
type-specification: {Var, Precision}. For example, real{{x, 
0.02}) specifies a precision of 0.02. 

4. Relational Constraints (RelExpr) . 

Valid relational constraints (and the associated relational 
operators ) include : 

(equality) : AlgExpr = AlgExpr, e.g. A = B, 

A+5*Z = sqrt (16) + C. 

(inequality) : AlgExpr =/= AlgExpr, e.g. 4*X+ 
5*Y=/= 2*A+ 3*B. 

(less than) : AlgExpr < AlgExpr, e.g. A< B, A+ 



(greater than) : AlgExpr > AlgExpr, e.g. A> B, A+ 
4*Z > 4 + C. 

= " (less than or equal to) : AlgExpr <= AlgExpr e.g. 
A<= B, A+ 4*Z<- 4+ C. 
5 ^^>='' (greater than or equal to) : AlgExpr >= AlgExpr, 

e.g. A>= B, A+ 4*Z>= 4+ C. 

^^NOT^' : NOT RelExpr, e.g. NOT (is_prime (X) = true). 
5 . Ranges . 

''Continuous interval'': To specify a variable Var within a 
10 continuous range: [LowerExpr RL Var RL UpperExpr] where RL is 
one of the relational operators: { <, <=, >, >= }, e.g. to 
:]| specify the constraint that X may range from 0 through 10: [0 < = 
y| X <= 10] . 

Q ''Continuous exterval" : To specify a variable Var outside a 

15 continuous range: [I LowerExpr RL Var RL UpperExpr] where (RL is 
one of the relational operators: { <, < = , >, >= }.) For example, 
to specify the constraint that X must be outside the range from 
of 0 through 10: [! 0 <= X <= 10] . 

"Discrete inclusive range" : To specify a variable Var 
2 0 within an enumerated range: Var in [Exprl, Exprl, ...]. For 

example, X in [1, 5, 4+3, a, 2, 15], or, X in [1, 2*Y+ Z, 7, 
Z] . The Var assumes each value from the given set of values. 
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''Discrete exclusive range" : To specify a variable Var 
outside an enumerated range: Var notin [Exprl, Expr2, ...], For 
example, X notin [1, 5, 4+3, a, 2, 15], or, X notin [1, 2*Y+ 
Z, 7, Z] . 

6 . Enumerated Ranges . 
To specify an enumerated range, we use: [LowerExpr RL Var RL 
UpperExpr step Expr] where (RL is one of the relational 
operators: { <, <=, >, >= }.) ■ Thus, for example, to specify 
that (a real variable) X enumerates through the range from 7 
though 10 by a step of 0.5: [7<= X<= 10 step 0.5] . The example 
constraint is equivalent to: {X= 7; X= 7.5; X= 8; X= 8.5; X= 9; 
X= 9.5; X= 10) , 

To specify a discrete enumerated range, we use: Var from 
List. Thus, for example, to specify that (a variable) X can take 
11 one of the values from the set [a, b, c, d] , we use: X from [a, 
=f b, c, d] . Similarly, to specify that another variable Y can take 
a value from the set of primes between 2 and 10, we can use: Y 
from [2, 3, 5, 7] . 

If a continues enumeration range is not closed on lower 
[upper] side (e.g., left relational operator is <) , the lower 
[upper] expression is incremented [decremented] by the 
variable-precision for expanding the enumeration range. Thus, 
for example, for a real variable X with precision of 0.1, [7< X< 



10 step 0.5] . => (X= 7.1; X= 7.6; X= 8.1; X= 8.6; X= 9.1; X= 
9.6) . 

Note that an enumerated range is different from a regular 
(i.e. non- enumerated) range. The difference is especially 
5 visible for open (or, partially closed) ranges. For example, for 
a real variable X with precision of 0.1, the constraint: [7< X< 

10 step 0.5], X= 7.4. is not successful, but the constraint: [7< 
X< 10], X= 7.4. succeeds. 

Further, the main-variable in an enumerated range is 
10 ^-J considered independent, whereas the main-variable in a 

'f^l non- enumerated range is not independent. This difference becomes 
i: important when one is trying to generate different solutions for 
ji a constraint from the solver. While solving for different 

solutions, the constraint-solver tries to find different values 
15 Q for the independent variables in different solutions. It makes 
P no such effort for non-independent variables. 

Note that a user may not use variables in specifying the 
boundary (s) of an enumerated range when solving the constraints 
in the unique-order. As such, when solving the constraints in 
20 unique order, an enumeration range such as: [C+1 <=X <= C+3 step 

11 is not acceptable because it uses variables in specifying the 
boundaries of the enumerated range. 

7. if -then-else Constraint. 
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if (Condition) then (Then-Constraint) else 
(Else-Constraint). For example, if (is_prime (X) = true) then (Y= 
found_an_x_as__prime) else (Y= no_x__is_prime) . ( if-then alone 
also be used e.g. if (X== 5) then (Y= 7).) 

Note that the semantics of the if -then-else constraint is: 
if Condition is ever true, then only the Then-Constraint is 
tested (i.e. executed). Only when the Condition is never true, 
the Else-Condition is tested (i.e. executed). Thus, for example 
the following if-then-else constraint produces the results shown 
below: 

int(X), [1<=X<=4 step 1], if (even(X)- true) 
then Y= x_is_even else Y= x__is_odd. => 
X: 2, Y: x_is_even; 
X : 4 , Y : x_i s__e ven . 
Refer to the if - then-elseif constraint for a slightly different 
kind of constraint. 

8. if -then-elseif Constraint, 
if (Then-Condition) then (Then-Constraint) elseif 
(Else-Condition) then (Else-Constraint), e.g. the following 
constraint produces the absolute-values of X: 
if (X>= 0) then (Y= X) elseif (X< 0) then (Y= -X) . 

Note that the semantics of the if -then-elseif constraint is 
if Then-Condition is true, then the Then-Constraint is tested 



(i.e. executed); or if Else-Condition is true, then the 
Else-Constraint is tested (i.e. executed). Thus, for example, 
the following if -then-elseif constraint produces the results 
shown : 

int(X), [1<=X<=5 step 1], if (even(X)= true) 
then Y= x_is_even elseif (odd(X)= true) then 
Y= x_is__odd. => 

X: 1, Y: x_is_odd; 
X: 2, Y: x_is_even; 
X : 3 f Y : x_i s_odd ; 
X: 4, Y: x__is_even. 
n Refer to the if-then-else constraint for a slightly different 
kind of constraint . 

9. Freeze Constraint. 
Usually, one is interested in exploring the entire 

solution-space. However, there are times when one is satisfied 
with the solution (set) received so far, and wishes to freeze the 
solution (set) discovered so far. The freeze constraint is 
represented by the keyword: freeze. 

10. Primitive succeed and fail constraints. 
One can force a constraint to fail by conjunct ing fail with 

it. Thus, for example, X= 4, fail. => false. Similarly, 
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succeed succeeds vacuously e.g. if (X> 4) then succeed else 
fail. 

11. Period (.) at the end of constraints. 

12. Combining Constraints. 

5 Grouping constraints together: ( Constraint 

For example, (X = 4 + X, Y= 2) . 

Conjunction (and): "Constraintl , Constraint2 " . 
For example, X*X= 25, Y= 5, X= Y, => {X: 5, Y:5}. 
Disjunction (or): "Constraintl ; Constraint2 " . 
10 :;;{ For example, X*X- 25; Y= 5, X= Y. => {X: 5; X: -5; X: 5, Y: 5}. 
Ql Negation: "NOT Constraint". 

:,n For example, NOT (X= 5) . 

Note that NOT (X= 5) (i.e., it is never the case that X is 5) is 
^-J not equivalent to X=/= 5 (i.e. the case when X is not 5). Thus: 
15 X in [1, 2], X=/= 1. produces only one answer: X: 2 (because 

% X=/=l succeeds when X: 2), whereas: X in [1, 2], NOT (X= 1). fails 
(because X= 1 succeeds when X: 1) . 

WRITING CONSTRAINTS IN TCA CONSTRAINT LANGUAGE 
2 0 The TCA constraint language combines the algebraic language 

with the syntax and semantics of logic programming language (for 
example, Prolog) . It differs considerably from the procedural 
programming languages (for example, C, Fortran) which rely on 
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program- flow control to specify a procedure to solve the problem 
at hand. Major differences between procedural languages and the 
TCA constraint language of the present invention include: 
TCA constraint language is declarative: In the TCA 
5 constraint language, one specifies only the constraints to be 
solved, not how to solve them. 

Constraints are order - independent : In the TCA constraint 
language, the constraints are order- independent e.g. X= 2, Y= 
X+2 . is the same as: Y= X+2 , X=2 . In procedural languages, 
10 statements are order- dependent , e.g. in C, X= 2; Y= X+2; is 
different from: Y- X+2; X= 2 . An exception to the 
.Jl order- independence of rules is the case where we use the 
q\ continuous -range constraint (e.g., [2<= X<= 5]) for integer 
Q variables and invoke functions with the variable from the 
15 U continuous range (e.g., Z= gcd(X,Y)), In such situations, the 
solver's behavior depends on the relative position of the 
variable-type-declaration (e.g., int (X) ) vs. the continuous range 
declaration (e.g., [2<= X<= 5]). In general, the user of the 
present invention should put the variable- type-declaration as 
20 soon as he/she knows it. For example, int (X) , Y= 5, [2<= X<= 
10] , Z= gcd(X, Y) . 

Constraints are solved all at once as a whole. 
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TCA constraint language provides its own program- flow 
control. As such, the TCA constraint language provides (almost) 
no other program- flow control mechanism. Procedural languages, 
on the other hand, have to provide a large number of them. For 
example, goto, while, if -then-else, and the implicit 
left-to-right, top-to-bottom program-flow. 

TCA constraints are (mostly) bidirectional. Because the TCA 
constraint language uses relations to implement most functions 
and operators, one can use the same function [operator] to map a 
set of arguments to a result, or to map a result back to a set of 
arguments. Thus, for example, X= 51. => X: 120, Further, 120= 
N! . => N: 5. In procedural languages, one has to explicitly 
apply the reverse function to achieve the effect illustrated 
above. For example, in C programming language, X= factorial (5) ; 
=> X= 120; and Y= reverse_factorial (12 0) ; => Y= 5. 

TCA constraint language has no value-storage and no 
assignment . 

With these fundamental differences between the logical and 
procedural paradigms, the techniques to achieve solutions are 
also different. In the following section, we describe some of 
the techniques to write the constraints and to solve them in TCA. 
SOME TECHNIQUES TO SOLVE CONSTRAINTS IN TCA 
1. Variable Type Specification. 



It helps if you can identify the type of the variable 
explicitly, particularly if it is not real (e.g. integer) . 
Examples of such type-specification follow: 

square(R) = 100, int (R) . 

X=Y^3, X=8, int (Y) . 

X=Y^3, X=8, real (Y) . 

2. Range specification. 

One can specify boundary conditions for a variable using any 
of the relational operators (e.g. >, >=, <, <=) available. One 
can also specify the boundary using the range or the discrete set 
notation. Some examples of boundary specification follow: 
X= 2, [4< Y< 5*X] , Z=Y+3. 
[2^2 <= X<= 2^4] , Y= X*2 . 

3. Enumerated-Range Specification. 

One can specify an enumerated range for a variable using the 
enumerated range construct. Some examples of enumerated-range 
specification follow: 

X= 2, [4< Y< 5*X step 0.5], Z=Y+3 . 
[2^2 <- X<= 2^4 step 0.3], Y= X*2 , 

4. Efficient Solving. 

For performance reasons, it is desirable to use only the 
constants in the enumerated range specifications of the 



independent variables, and impose any other constraints later in 
the constraint. Thus, for example, the following constraint: 
int(X,Y,Z), [1<=X<= 100 step 1], [1<-Y<=100 
step 1], [gcd(X, Y) <=Z< = 100 step 1] ; 
5 can be solved more efficiently as: 

int(X,Y,Z), [1<=X<= 100 step 1], [1<=Y<=100 
step 1], [1<=Z<=100 step 1], Z>= gcd(X,Y). 
5. Representing lists and tables. 
One can use (multilayered i.e. lists containing lists) lists 
10 Q to represent tables. For example, a 2x3 table (i.e. a table with 
^11 2 rows and 3 columns) can be represented as a 2 -element list of 

3-element lists e.g. Table_2_3= [ [1, 5, 7], [10, 50, 70]]. One 
ji can access the various table-elements using the (potentially, 
i-| multi -indexed) list-element-access notation: ListName [ Indexl [, 
15 Q Index2 [, Index3 ...]] ]. Note that the first element of the 
Cl list is indexed 1, second element is indexed 2, and so on. 
Multiple indices are used for multilayered lists. 

Some constraints involving tables and table -elements and 
their solutions are shown below: 
20 Tbl_4_l= [1, 3, 5, 7], X= Tbl_4_l [2] . => X: 3. 

Tbl_3_2-[[1,3] , [5,7] , [9,11]] , X=Tbl_3_2 [2] . => X: [5, 7]. 
Tbl_3_2=[[l,3] , [5,7] , [9,11]] ,X=Tbl_3_2[2,l] . => X: 5. 
Tbl_3_2= [ [a,b] , [c,d] , [e,f] ] , X=Tbl_3__2 [2 , 2 ] . => X: d. 



6. Bidirectionality of functions and operators. 

Since the operators and (a large number of) functions in TCA 
are implemented using relations, one can use the same operators 
and the functions to map forward and backward and a mixture of 
forward-and-backward mappings. For example, X= 4 ! + 5 . => X: 
29. On the other hand, 2 9= N1+ C, C>0. => (N : 4 , C : 5 ; N : 3 , 
C: 23; N: 2, C: 27; N: 1, C: 28; N: 0, C: 28). Similarly, 29= 
N!+ 5. => N: 4. 

7. Constraints are Solved in Order- independent Fashion. 
Because the constraints are solved as a whole, solutions to 

the constraints in TCA are (mostly) independent of the 
constraint -order. Thus, the constraints: Y= X^2, Y= 2*Z, Z= 2. 
and Z= 2, Y= 2*Z, Y= X^2 . provide exactly the same set of 
solutions: (X: 2, Y: 4, Z: 2; X: -2, Y: 4, Z: 2) . 

As a practical matter, though, since the constraints are 
solved left-to-right by the constraint-solver, it often helps to 
write the constraints in an order such that the more determined 
constraints are to the left of the less determined constraints. 

8. Constraints are Solved as a Whole. 

All the constraints specified for one constraint are all 
solved as a whole, and not partially. This is particularly 
important in the case of the TCA where constraints are entered on 
different lines without any explicit operators (e.g. comma or 



semicolon) combining them (TCA supplies the default 
comma-operator (i.e. conjunct) between adjacent constraints) and 
thus one might get the incorrect impression that the constraints 
are solved independently. 

9 . Variable Names are the Links to Bind Various 
Constraints . 

One binds various constraints through the variables used in 
them. Thus, use of the same variable X in constraints CI and C2 
(when CI and C2 are joined together by the and (i.e. comma) 
operator) is a statement to solve the constraints CI and C2 to 
^1 find the common value for X. For example, 5*5= X*X+ Y*Y, int (X, 
Y) , X= cubert(27). => {X: 3, Y: 4}. solves the constraints 5*5= 
X*X+ Y*Y, int(X, Y) and X= cubert (2 7) to provide the common 
solution: {X: 3, Y: 4 }, and discards the other solution: {X: 4, 
Y: 3 } for the first constraint. 

As a corollary, using the same variable-name in multiple 
constraints forces them to find a common solution. That is, you 
may unintentionally restrict a solution space by unintentionally 
using the same variable name across multiple constraints. 

10. Use of Sets and Ranges. 
One can use sets and ranges to solve constraints over 

continuous ranges or discrete sets. For example, [1<= X<= 10 
step 1], Y= X*X, int(X, Y) . returns (in Y) squares of integers 



from 1 through 10. Similarly, X in [-2, -4, 2, 4], Y= X*X*X. 
returns (in Y) the cubes of numbers from the given set. Sets and 
ranges can often be used in situations which might require 
loop-operators in procedural languages. 
5 11, Logical Operators. 

One can use conjuncts (the comma operator: disjuncts 
(the semicolon operator: ;), negation (NOT), and their 
combination (using parentheses) to provide any needed 
program- flow control, 
10 ;^:J 12. Equality by Assigning Same Variable Name. 

'{II One can impose equality constraint on variables by 

explicitly equating them or by just naming them as the same 
:j| variable. By corollary, variables with the same name must have 
Cl identical value. Thus, for example, [Divl, Modi] = divmod(16, 3), 
15 Zl [Div2, Mod2]= divmod(17, 3), Divl= Div2 . => (Divl: 5, Div2 : 5, 
Modi: 1, Mod2 : 2). We can impose the same constraint with more 
clarity and brevity as: [Div, _ ] = divmod(16, 3), [Div, _ ] = 
divmod(16, 3), => (Div: 5). 

2 0 Further descriptions of preferred embodiments of the present 

invention appears in the Figures and both Source Code Appendices, 
all of which are hereby incorporated herein in full. 
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VISUAL BASIC SOURCE CODE APPENDIX 
TABLE OF CONTENTS^ 



TCA.vbp VBSCA -1 

AXProlog.vbp VBSCA -4 

Common. has VBSCA -5 

Main. has VBSCA -6 

modUtil.bas VBSCA -7 

MTAPI.BAS VBSCA -12 

MTDeclaration.bas VBSCA -17 

MTUtil.bas VBSCA -21 

Timer. bas VBSCA -28 

Contraint . f rm VBSCA -29 

EditConstraint , f rm VBSCA -50 

Forml.frm VBSCA -52 

frmAbout.frm VBSCA -54 

f rmAttributes . f rm VBSCA -55 

f rmComments . f rm VBSCA -60 

frmDif f iculty . frm VBSCA -62 

frmDrag.frm VBSCA -76 

frmlED.frm VBSCA -79 

frmlndexedSt ring . frm VBSCA -81 



' All software COPYRIGHT 1999 ETS except for MTAPI.BAS 



f rmNew. f rm VBSCA -89 

f rniNewModel . f rm VBSCA -94 

f rmProgram. f rm VBSCA -97 

f rmProgress . f rm VBSCA -100 

frmProlog. frm VBSCA -102 

f rmSplash. frm VBSCA -104 

SetPrecision. f rm VBSCA -108 

String. frm VBSCA -111 

TCA.FRM VBSCA -114 

Variable, frm VBSCA -217 

Application, els VBSCA -254 

CClones.cls VBSCA -255 

CConstraints . els VBSCA -261 

Checksum. els VBSCA -268 

Clone, els VBSCA -270 

CModels.cls . VBSCA -279 

Constraint .els VBSCA -283 

ConstraintSolver . els VBSCA -288- 

CVariables , els VBSCA -297- 

CVariants . els VBSCA -3 08- 

Dif f ieultyEstimate . els VBSCA -311- 

DocStatus , els VBSCA -313- 

DSMODEL.CLS VBSCA -314- 
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Family, els . VBSCA -322 

File. els VBSCA -328 

5 FileFind.cls VBSCA -333 

GMATDif f icultyEstimate. els VBSCA -336 

GREDif f icultyEstimate . els VBSCA -340 

10 

IniFile.cls VBSCA -345 

Loekedltem. els VBSCA -350 

15 Model, els VBSCA -362 

PrintModel . els VBSCA -381 

Q Progress. els VBSCA -384 

2 0 y| 

l^jj Prolog, els VBSCA -386 

PSMODEL.els VBSCA -3 92 

25 'l^ QCModel.els . VBSCA -403 

:;:| StringSolver . els VBSCA -410 

Q StringSolverx, els VBSCA -412 

3 0 Q 

Q Substring, els VBSCA -413 

Value. els VBSCA -417 

35 VarFraetion. els VBSCA -419 

Variable. els VBSCA -428 

Varlnteger . els VBSCA -432 

40 

VarReal.cls VBSCA -439 

VarString. els VBSCA -44 9 

45 VarUntyped. els VBSCA -456 
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Win32API .els 
Word. els . . 



VBSCA -462- 
VBSCA -465- 



iJl 

j: 

n 
u 
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PROLOG SOURCE CODE APPENDIX 
TABLE OF CONTENTS^ 



10 



15 



LI1 
4:; 



HLP4lib.p4 PROLOG SCA -1- 

PrlgExpr. 1 PROLOG SCA -13- 

PrlgExpr.y PROLOG SCA -16- 

hlP4API.h PROLOG SCA -90- 



^ All software COPYRIGHT 1999 ETS 
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CLAIMS 

WE CLAIM: 

1. A computerized method for creating test item models and 
generating test item variants comprising the steps of: 

a. obtaining a test item; 

b. creating a model by; 

i. identifying elements of the test item to be 
variabilized; 

ii. variabilizing the elements to create variables; 

iii. defining the variables; 

c. generating a test item variant using a simultaneous 
constraint solver . 

2. The method according to claim 1, wherein said model creation 
further comprises specifying constraints that define the 
relationship among the variables. 

3. The method according to claim 2 further comprising the step 
of accepting and retrievably storing the test item variant. 

4. The method according to claim 3 further comprising the step 
of accepting and retrievably storing the test item model. 

5. A computerized method for generating test item variants, the 
method comprising: 

b. identifying elements of a test item or a test item 
model to be variabilized; 

c. variablizing the identified elements; 



d. defining the variables; 

e. specifying constraints; 

f. using a simultaneous constraint solver to determine 
values for the variables; 

g. generating test item variants. 

A computerized system for generating test item variants from 
St item models comprising: 

a. means for retrievably storing test item models; 

b. means for selecting a test item model; 

c. means for simultaneously solving test item model 
constraints ; 

d. means for generating test item solutions by 
simultaneously solving test item model constraints; 

e. means for displaying, accepting and retrievably storing 
valid test item solutions. 

The computerized system of claim 6 further comprising: 

a. means for obtaining a test item; 

b. means for identifying elements of the test item to be 
variabilized; 

c. means for variabilizing the elements to create 
variables ; 

d. means for defining the variables; 



e. means for accepting the variabilized test item with 
defined variables as a test item model. 

8. The computerized system of claim 7 further comprising means 
for specifying constraints that define the relationship among he 
variables . 

9. The computerized system of claim 8 further comprising 
implementation of the VISUAL BASIC SOURCE CODE set forth in the 
VISUAL BASIC SOURCE CODE APPENDIX. 

10. The computerized system of claim 8 further comprising 
implementation of the PROLOG SOURCE CODE set forth in the PROLOG 
SOURCE CODE APPENDIX. 

11. The computerized system of claim 6 further comprising means 
for displaying, accepting and retrievably storing the test item 
model . 

12. A computerized system for generating test item variants 
comprising : 

a. means for creating, editing and storing variabilized 
and non-variabilized test items; 

b. means for selectively variabilizing test item elements; 

c. means for defining test item element variables; 

d. means for simultaneously solving variabilized test item 
element constraints ; 

e. means for displaying and storing accepted test items, 
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13. A computerized method for generating test item variants from 
test item models comprising: 

a. retrievably storing test item models; 

b. selecting a test item model; 

5 c. simultaneously solving test item model constraints and 

generating test item solutions; 
e. displaying, accepting and retrievably storing valid 
test item solutions. 

14. The computerized method of claim 13 wherein the step of 
10 Cl retrievably storing test items models comprises: 

-^l a. obtaining a test item; 

b. identifying elements of the test item to be 
variabilized; 

Q c- variabilizing the elements to create variables; 

15 Q d. defining the variables; 

9 ^- accepting the variabilized test item with defined 

variables as a test item model . 

15. The computerized method of claim 13 further comprising 
specifying constraints that define the relationship among he 

2 0 variables, 

16. The computerized method of claim 14 further comprising the 
steps of displaying and retrievably storing the accepted test 
item model . 



17. The computerized method of claim 14 wherein the test item 
model constraints are simultaneously solved using PROLOG IV and 
TCA constraint language. 

18. The computerized method of claim 17 wherein the Prolog 
5 simultaneous constraint solver is the PROLOG SOURCE CODE set 

forth in the PROLOG SOURCE CODE APPENDIX. 

19. The computerized method of claim 14 wherein variables can be 
defined by values which are variables. 

20. The computerized method of claim 15 wherein the variables 
10 are new variables for which new constraints are defined as 

Cm needed. 
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ABSTRACT 

A computerized method and system for creating test items by 
generating variants from a test item model, comprising the steps 
of creating a new test item model by identifying elements of an 
initial test item or test item model to be variabilized, 
variabilizing the elements thereby creating test item variables, 
indicating values the variables can assume, defining the 
variables, and generating test item variants utilizing a 
simultaneous constraint solver. The initial test item can be a 
pre-existing test item or test item model, a newly created test 
item or even a conceptual template in the mind of the test item 
creator. The generated test item variants are displayed to the 
test item creator. The test item creator can store and forward 
acceptable test item variants for later use as test items. Test 
item models can be stored for later use in generating new test 
item variants. 
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IN THE UNITED STATES PATENT AND TRADEMARK OFFICE 
BEFORE THE PATENT EXAMINING OPERATION 



ATTN'Y DOCKET NO.: ETS-TCA 
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Variables and constraints for model NEWMC$R 



Variables: 
Variable name: SMaleName 
Type: String 
Status: Enabled 
Checksum: Enabled 
Indexed: False 
Values: 

John 

Tom 

Richard 

Michael 

Steve 

Phil 

Jeff 

Peter 

Hany 

Variable name: INum1 
-^ype: Integer 
=1 Status: Enabled 
0 Checksum: Enabled 

iis independent = True, Range: from 2 to 26 by 3 
Vttiable name: S Items 
If ype: String 
IStatus: Enabled 
JChecksum: Enabled 
Indexed: False 
CValues: 
II apples 
Q oranges 
u pears 
r| marbles 
f;i pennies 
comic books 
pieces of bubble gum 
pencils 
crayons 
Variable name: SFemaleName 
Type: String 
Status: Enabled 
Checksum: Enabled 
Indexed: False 
Values: 
Mary 
Sharon 
Tina 
Michelle 
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FIG. 80A 



Variables and constraints for model NEWMC$R 



Susan 

Linda 

Crystal 

Deidre 
Variable name: INum2 
Type: Integer 
Status: Enabled 
Checksum: Enabled 

Is independent = True, Range: from 2 to 27 by 5 
Variable name: IKey 
Type: Integer 
Status: Enabled 
Checksum: Enabled 
Is independent = False 
Variable name: IDistractorl 
Type: Integer 
CStatus: Enabled 
^Checksum: Enabled 
yfe independent = False 
Variable name: IDistractor2 
IType: Integer 
iStatus: Enabled 
IChecksum: Enabled 
lis independent = False 
Variable name: IDistractorS 
iffype: Integer 
#tatus: Enabled 
i^fjhecksum: Enabled 
ps independent = False 
Vafable name: IDistractor4 
f^ype: Integer 
"Status: Enabled 
Checksum: Enabled 
Is independent = False 
Constraints: 
Variation constraints: 

Constraint: IKey=INum1+INum2 

Status: Enabled 
Constraint: [Num1=/=INum2 
Status: Enabled 
Distractor constraints: 

Constraint: IDistractorl =INum1+INum2+2*min(INum1 

Status: Enabled 
Constraint: IDistractor2=2*INum1 +INum2 

Status: Enabled 
Constraint: IDistractor3=INum1 +INum2+7 
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Variables and constraints for model NEWMC$R 



Status: Enabled 
Constraint: IDistractor4=IKey-3 
Status: Enabled 
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Variables and constraints for model NEWMC$RA 



Variables: 
Variable name: SMaleName 
Type: String 
Status: Enabled 
Checksum: Enabled 
Indexed: False 
Values: 

John 

Tom 

Richard 

Michael 

Steve 

Phil 

Jeff 

Peter 

Harry 

Variable name: INum1 
I Type: Integer 
ij Status: Enabled 
UPhecksum; Enabled 

.|Js independent = True, Range: from 2 to 26 by 3 
Variable name: SItems 
4 Type: String 
iStatus: Enabled 
. Checksum: Enabled 
r Indexed: False 
ii/alues: 
£1 apples 
CI oranges 
CI pears 
A martDies 
pennies 
comic books 
pieces of bubble gum 
pencils 
crayons 
Variable name: SFemaleName 
Type: String 
Status: Enabled 
Checksum: Enabled 
Indexed: False 
Values: 
Mary 
Sharon 
Tina 
Michelle 
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Variables and constraints for model NEWMC$RA 



Susan 

Linda 

Crystal 

Deidre 
Variable name: INum2 
Type: Integer 
Status: Enabled 
Checksum: Enabled 

Is independent = True, Range: from 2 to 27 by 5 
Variable name: IKey 
Type: Integer 
Status: Enabled 
Checksum: Enabled 
Is independent = False 
Variable name: IDistractorl 
Type: Integer 
iiStatus: Enabled 
iChecksum: Enabled 
ijfs independent = False 
Vsifiable name: IDistractor2 
IType: Integer 
IStatus: Enabled 
JChecksum: Enabled 
lis independent = False 
Variable name: IDistractorS 
CType: Integer 
iStatus: Enabled 
^Checksum: Enabled 
iJs independent = False 
Variable name: IDistractor4 
JJtype: Integer 
Status: Enabled 
Checksum: Enabled 
Is independent = False 
Constraints: 
Variation constraints: 

Constraint: IKey=INum1+INum2 

Status: Enabled 
Constraint: INum1=/=INum2 
Status: Enabled 
Distractor constraints: 

Constraint: IDistractorl =INum1+|Num2+2*min(INum1,lNum2) 

Status: Enabled 
Constraint: IDistractor2=2*INum1 +INum2 

Status: Enabled 
Constraint: IDistractor3=INum1+INum2+7 
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Variables and constraints for model NEWMC$RA 



Status: Enabled 
Constraint: IDistractor4=IKey-3 
Status: Enabled 



a 

m 
ui 

I; 

CI 

Cl 
CI 
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FILE: NEWMC$R.doc 

TCA Standard Multiple Choice Model 

reserved for variant 



stem 

If SMaleName has INuml SItems and 
SFemaleName has INum2 SItems, how many 
SItems do they have together? 



key 

IKey 

distractorl 

IDistractorl 



distractor2 

IDistractor2 



distractorS 

IDistractorS 



dlstractor4 

IDistractQr4 



dIstractorS 

Distractor5 



distractore 

Distractor6 



distractor7 

Distractor? 



distractorS 

DistractorS 



scratch pad 

Scratch Pad Area 



FIG. 83 



FILE: NEWMC$R3.doc 
TCA Standard Multiple Choice Model 
reserved for variant 

If Tom has 2 comic books and Crystal has 12 comic 
books, how many comic books do they have 
together? 



Stem 

If Tom has 2 comic books and Crystal has 12 comic 
books, how many comic books do they have 
together? 

key 

— 



distractorl 

lis 



distractor2 

T6 



distractorS 

21 



distractor4 

" ~i 

distractorS 

DistractorS 



distractorS 

Distractor6 



distractorT 

Distractor? 



distractorS 

DistractorS 



scratch pad 

Scratch Pad Area 
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FILE: NEWMC$R4.doc 
TCA Standard Multiple Choice Model 
reserved for variant 

If Harry has 17 pears and Mary has 2 pears, how 
many pears do they have together? 

Stem 

If Harry has 1 7 pears and Mary has 2 pears, how 
many pears do they have to gether? 

key 

— - 



distractorl 

23 



distractor2 

36 



distractorS 

26 



distractor4 

l6 



dlstractorS 

DistractorS 



distractor6 

Distractor6 



distractor7 

Distractor? 



dlstractorS 

DistractorS 



scratch pad 

Scratch Pad Area 
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FILE: NEWMC$RA.doc 
TCA Standard Multiple Choice Model 
reserved for variant 

If Harry has 17 pears and Mary has 2 pears, how 
many pears do they have together? 



Stem 

If Harry has 17 pears and Mary has 2 pears, how 
many pears do they have together? 

key 

— - 



distractorl 

23 



distractor2 

36 



distractorS 

26 



distractor4 



distractorS 

DistractorS 



distractorS 

Distractor6 



distractor? 

Distractor? 



distractorS 

DistractorS 



scratch pad 

Scratch Pad Area 
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FILE: NEWMC$RB.doc 
TCA Standard Multiple Choice Model 
reserved for variant 



stem 

If SMaleName has INuml SItems and 
SFemaleName has INum2 SItems, how many 
SItems do they have together? 



key 

IKey 



distractorl 

IDistractorl 



distractor2 

IDistractor2 



distractorS 

IDistractorS 



distractor4 

IDistractor4 



distractorS 

DistractorS 



distractorS 

E)istractor6 



distractor? 

Distractor? 



distractorS 

DistractorS 



scratch pad 

Scratch Pad Area 
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FILE: NEWMC$RBA.doc 
TCA Standard Multiple Choice Model 
reserved for variant 



stem 

If SMaleName has INuml SItems and 
SFemaleName has INum2 SItems, how many 
SItems do they have together? 



key 

IKey 



distractorl 

IDistractori 



distractor2 

n;)istractor2 



distractorS 

IDistractorS 



distractor4 

IDistractor4 



distractorS 

DistractorS 



distractorS 

Distractor6 



distractor? 

Distractor? 



distractorS 

DistractorS 



scratch pad 

Scratch Pad Area 
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FILE: NEWQC$R.doc 
TCA Quantitative Comparison Model 
reserved for variant 



Colmnn A Column B 



(a) The qu^tity in Column A is greater. 

(b) The quantity in Column B is greater. 

(c) The two quantities are equal. 

(d) The relationship cannot be determined from the 
information given. 



Stem 




column A 


column A value 






column B 


column B value 






key 


Key 


scratch pad 


Scratch 




Pad 




Area 
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FILE: NEWDS$R.doc 
TCA Data Sufficiency IModel 
reserved for variant 



Statemmt (1) 
Statemoit (2) 

(a) StatemQit(l) ALONE is sufficient 

(b) Statement (2) ALONE is sufficient. 

(c) Statemmts TOGETHER are sufficient. 

(d) EACH statemmt ALONE is sufficient. 

(e) Statemaits TOGETHER are NOT sufficient. 



Stem 



first statement N/S/E 



second statement N/S/E 



key 

Key 



scratch pad 

Scratdi 

Pad 

Area 
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FILE: MICNEWMC$R1.doc 
TCA Standard Multiple Choice Model 
reserved for variant 

If Bill had 2 apples and Teresa had 5 apples, how many apples did 
they have together? 

A. 3 

B. 4 

C. 7 

D. 10 

E. 13 
Key is C 



Stem 

If Bill had 2 apples and Teresa had 5 apples, how many apples did 
they have together? 



key 

7 



distractorl 



distractor2 

To 



distractor3 



distractor4 

4 



distractorS 

DistractorS 



distractore 

Distractor6 



djstractor? 

Distractor? 



distractorS 

DistractorS 



scratch pad 

Scratch Pad Area 
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FILE: MlCNEWMC$RA.doc 
TCA Standard Multiple Choice Model 
reserved for variant 

If Bill had 2 apples and Joan had 4 apples, how many apples did they 
have together? 

A. 2 

B. 4 

C. 6 

D. 8 

E. 10 

Key is C 



Stem 

If Bill had 2 apples and Joan had 4 apples, how many apples did they 
have together? 



key 

distractorl 



distractor2 

8 



dlstractorS 

To 



distractor4 

4 



distractorS 

Distractor5 



distractorG 

Distractor6 



dlstractor? 

Distractor? 



distractorS 

DistractorS 



scratch pad 

Scratch Pad Area 
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FILE: MICNEWMC$R2.doc 
TCA Standard Multiple Choice Model 
reserved for variant 

If Bill had 2 apples and Joan had 4 apples, how many apples did they 
have together? 

A. 2 

B. 4 

C. 6 

D. 8 

E. 10 
Key is C 



Stem 

If Bill had 2 apples and Joan had 4 apples, how many apples did they 
have together? 



key 

6 



distractorl 

2 



djstractor2 



^ I 

distractorS 

"To ' " 1 



distractor4 

4 



distractorS 

DistractorS 



diStractor6 

Distractor6 



distractor? 

DistractorT 



distractof^ 

DistractorS 



scratch pad 

I Scratch Pad Area 
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Variables and constraints for model MICNEWMC$R 



Variables: 
Variable name: SMaleName 
Type: String 
Status: Enabled 
Checksum: Enabled 
Indexed: False 
Values: 

Michael 

Bill 

Harry 

Roger 
Variable name: INum1 
Type: Integer 
Status: Enabled 
Checksum: Enabled 

Is independent = True. Range: from 2 to 8 by 1 
V^iiable name: SThing 
llype: String 
^Status; Enabled 
.Checksum: Enabled 
Iftdexed: False 
J/alues: 

apples 
II uzis 

Variable name; SFemaleName 
lype: String 
status: Enabled 
iDhecksum: Enabled 
Itadexed: False 
Values: 
Q Holly 

Mary 

Teresa 

Joan 

Variable name: INum2 
Type: Integer 
Status: Enabled 
Checksum: Enabled 

Is independent = Tme, Range: from 4 to 12 by 1 
Variable name: IKey 

Type: Integer 

Status: Enabled 

Checksum: Enabled 

Is independent = False 
Variable name: IDistractorl 

Type: Integer 
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Variables and constraints for model MICNEWMC$R 



Status: Enabled 

Checksum: Enabled 

Is independent = False 
Variable name: IDistractor2 

Type: Integer 

Status: Enabled 

Checksum: Enabled 

Is independent = False 
Variable name: IDistractor3 

Type: Integer 

Status: Enabled 

Checksum: Enabled 

Is independent = False 
Variable name: IDistractor4 

Type: Integer 

Status: Enabled 

iShecksum: Enabled 

Is independent = False 
Consiraints: 
Variation constraints: 

Constraint: IKey = INum1 + INum2 

II Status: Enabled 
Distractor constraints: 
.Constraint: IDistractorl = |INum1 - INum2| 

Status: Enabled 
igonstraint: IDistractor2 = INum1 * INum2 

Ji Status: Enabled 

Constraint: IDistractor3 = IDistractorl + IDistractor2 

Status: Enabled 
Igonstraint: IDistractor4 = 2 * INum1 
O Status: Enabled 
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FILE: MICNEWQC$R.doc 
TCA Quantitative Comparison IModel 



reserved for variant 



Colomii A 


Colomn B 






(a) The quantity in Column A is greater. 


(b) The quantity in Column B is greater. 


(c) The two quantities are equal 




(d) The relationship cannot be determined from flie information 


given. 





stem 

An article of clothing was reduced in price by x percent from 
SlOriginalPrice to SIReducedPrice. Later, the price was increased by 
y percent to return the price to SlOriginalPrice. 



column A column B 



X 


y 


x + 1 


y-l 



key 

Key 



scratch pad 

Scratch 

Pad 

Area 
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FILE: MICNEWQC$R1.doc 
TCA Quantitative Comparison Model 
reserved for variant 

An article of clothing was reduced in price by x percent from $20 to 
$16, Later, the price was ino-eased by y percent to return the price to 
$20. 

Ctdmian A Colmnn B 



x+ 1 



1 



(a) Hie quantity in Column A is greater. 

(b) The quantity in Column B is greater. 

(c) The two quantities are equal. 

(d) The relationship cannot be determined from the information 
given. 



Stem 

An article of clothing was reduced in price by x percent from $20 to 
$16. Later, the price was increased by y percent to return the price to 
$20. 



column A column B 



X 


y 


x+ 1 


y-l 



key 



scratch pad 

Scratch 

Pad 

Area 
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FILE: M>CNEWQC$R5.doc 
TCA Quantitative Comparison l\/lodel 



reserved for variant 



An article of clothing was reduced in price by x percent from $25 to 


$20. Later, the price was increased by y percent to return the price to 


$25, 




Column A 


Column B 


x+1 


y 


(a) The quantity in Column A is greater. 


(b) The quantity in Column B is ^eater. 


(c) The two quantities are equal. 




(d) The relationship cannot be determined from the information 


given. 





stem 

An article of clothing was reduced in price by x percent from $25 to 
$20. Later, the price was increased by y percent to return the price to 
$25, 



column A column B 



X 


y 


x+ 1 


y-l 



key 

Key 



scratch pad 

Scratch 

Pad 

Area 
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FILE: MICNEWDS$R.doc 
TCA Data Sufficiency Model 
reserved for variant 



statement (1) 
Statem^t (2) 

(a) Statement (1) ALONE is sufficiait. 

(b) Statement (2) ALONE is suflBcient. 

(c) Statements TOGETHER are sufficient. 

(d) EACH statement ALONE is sufficient. 

(e) Statements TOGETHER are NOT sufficient. 



Stem 

A SThing.l and a SThing.2 cost a total of SICostL How much does 
the SThing.2 cost? 



first statement 

The SThing.l costs SRelationship as much as the SThmg.2. 



second statement 

The SThing. 1 costs SICostT 

key 



scratch pad 

Scratch 

Pad 

Area 
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Variables and constraints for model MICNEWDS$R 



Variables: 
Variable name: SThing 
Type: String 
Status: Enabled 
Checksum: Disabled 
Indexed: True 
Value Sets: 
Values: 

1. apples 

2. oranges 
Values: 

1. hat 

2. coat 
Variable name: ICostI 

Type: Integer 
Status: Enabled 
iQhecksum: Enabled 
Is independent = False 
Vafable name: ICost2 
jfype: Integer 
Ifatus: Enabled 
liiecksum: Enabled 
Ig independent = False 
Val^bie name: ITotalCost 
Type: Integer 
Status: Enabled 
i^ecksum: Enabled 

independent = True, Range: from 40 to SVal by 1 
Vaglble name: SVal 
type: String 
S(atus: Enabled 
Checksum: Enabled 
Indexed: False 
Values: 

50 

55 

60 

65 

Variable name: SRelationship 
Type: String 
Status: Enabled 
Checksum: Enabled 
Indexed: False 
Values: 

half 

twice 
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Variables and constraints for model MICNEWDS$R 



one quarter 
three times 
Constraints: 
Variation constraints: 
Constraint: ITotalCost = iCostI + ICost2 

Status: Enabled 
Constraint: ICostI = ITotalCost - 20 
Status: Enabled 
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IN THE UNITED STATES PATENT AND TRADEMARK OFFICE 



BEFORE THE PATENT EXAMINING OPERATION 



ATTN'Y DOCKET NO.: ETS-TCA 

APPLICATION OF: PETER BRITTINGHAM, MARY E. MORLEY, MARK K. 

SINGLEY, MARK G. ZELMAN, KRISHNA N, JHA, 
JAMES H. FIFE, ROBERT L. RARICH, IRVIN R. 
KATZ, RANDY E. BENNETT 

FOR: COMPUTER-BASED TEST-ITEM GENERATION AND 

CLONING 



VISUAL BASIC SOURCE CODE APPENDIX 

(VBSCA 1-469) 



EI469815916US 



VISUAL BASIC SOURCE CODE APPENDIX 
TABLE OF CONTENTS' 



TCA.vbp VBSCA-1- 

AXProlog.vbp VBSCA-4- 

Common.bas VBSCA-5- 

Main.bas VBSCA -6- 

modUtil.bas VBSCA -7- 

MTAPI.BAS VBSCA -12- 

MTDeclaration.bas VBSCA -17- 

MTUtil.bas VBSCA -21- 

Timer.bas VBSCA -28- 

Contraint.frm VBSCA -29- 

EditConstraintfrm VBSCA -50- 

Forml.frm VBSCA -52- 

frmAboutftm VBSCA -54- 

frmAttributes.ftm VBSCA -55- 

fmiComments.frm VBSCA -60- 

frmDifficulty.frm VBSCA -62- 

frmDrag.frm VBSCA -76- 

frmlED.frm VBSCA -79- 

frmlndexedString.frm VBSCA -81- 

' All software COPYRIGHT 1999 ETS except for MTAPI.BAS 



• 



frmNew.frm VBSCA-89- 

frmNewModel.&m VBSCA -94- 

frmProgram.frai VBSCA -97- 

^ 5 frmProgress.frm VBSCA -100- 

frmProlog.frm VBSCA -102- 

frmSplash.frm VBSCA -104- 

• SetPrecision.frm VBSCA -108- 

String.frm VBSCA -111- 

10 TCA.FRM VBSCA -114- 

• ... 

% Variable.fhn VBSCA -217- 

Ijl Applicationxls VBSCA -254- 

• i CClones.cls VBSCA -255- 

€^ CConstraints.cls VBSCA -261- 

f| Checksum.cls VBSCA -268- 

• FJ Clone.cls VBSCA -270- 

□ CModels.cls VBSCA -279- 

^ Constraint.cls VBSCA -283- 

ConstraintSolver.cls VBSCA -288- 

20 CVariables.cls VBSCA -297- 

• CVariants.cls VBSCA -308- 

DifficultyEstimate.cls VBSCA -311- 

DocStatus.cls VBSCA -313- 

DSMODEL.CLS VBSCA -314- 



Family.cls VBSCA -322- 

File.cls VBSCA -328- 

FileFind.cls VBSCA -333- 

GMATDifficultyEstimate.cls VBSCA -336- 

GREDifficultyEstimate.cls VBSCA -340- 

IniFile.cls VBSCA -345- 

Lockedltemxls VBSCA -350- 

Model.cls VBSCA -362- 

PrintModel.cls VBSCA -381- 

Progress.cls VBSCA -384- 

Prolog.cls VBSCA -386- 

PSMODEL.cls VBSCA -392- 

QCModel.cls VBSCA -403- 

StringSolver.cls VBSCA -410- 

StringSolverx.cls VBSCA -412- 

SubString.cls VBSCA -413- 

Value.cls VBSCA -417- 

VarFraction.cls VBSCA -419- 

Variable.cls VBSCA -428- 

Varlnteger.cls VBSCA -432- 

VarReal.cls VBSCA -439- 

VarString.cls VBSCA -449- 

VarUntyped.cls VBSCA -456- 



Win32APLcls VBSCA -462- 

Word.cls VBSCA -466- 



' TCA.vbp 
Type=Exe 

Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#.A.A.A.AWINNT\System32^ 
Std01e2.Tlb#0LE Automation 

Reference=*\G{00020905-0000-0000-C000-000000000046}#8.0#409#.A.A,.\Microsoft 
Office\Office\MSWORD8.0LB#Microsoft Word 8.0 Object Library 

Reference=*\G{953298D7-F0DE-llD2-AED3-000000000000}#13.0#0#AXProlog.exe#AXProl 
og 

Object={FE0065C0-lB7B-llCF-9D53-00AA003C9CB6}#Ll#0; COMCT232,OCX 

Object={6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0; COMCTL32.0CX 

Object={BDC217C8-ED16-llCD-956C-0000C04E4C0A}#l.l#0; TABCTL32.0CX 

Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.0CX 

Form=TCA.frm 

Module^Util; modUtil.bas 

Class=Model; ModeLcls 

Class=Constraint; Constraint. els 

Class=Variable; Variablexls 

Class=TCAApplication; Application, els 

Module=StartUp; Main.bas 

Form=Variable.fhn 

Class=C Variables; CVariables.cls 

Class^CConstraints; CConstraintsxls 

Form==Constraint , fhn 

Class=MSWord; Word.els 

Form=frmSplash.frm 

Class=VarInteger; Varlnteger.cls 

Class=VarReal; VarReal.cls 

Class=VarFraction; VarFraction.cls 

Class=VarString; VarString.cls 

Form==frmIndexedString.frm 

Class=File; File.cls 

Class=CClones; CClonesxls 

Class^IniFile; IniFile.cIs 

Class=Win32API; Win32APLcls 

Class=CModels; CModels.cls 

Class=Clone; Clone.cls 

Form^fhnAttributes.frm 

Class=Family; Family.cls 

Class=DocStatus; DocStatus.cls 

Class=Checksum; Checksum.cls 

Form=frmProgress.frm 

Class=Progress; Progress, els 

Form=frmDiffieulty . frm 

Class=DifficultyEstimate; DifficultyEstimate.cIs 



VBSCA-1- 



Class=GREDifficultyEstimate; GREDifficultyEstimate.cls 
Class=SMCModel; PSModel.cls 
Class=QCModel; qcmodelcls 
Class=DSModel; dsmodel.cls 
Class=VarUntyped; VarUntyped.cls 
Class^Lockedltem; Lockedltem.cls 

Class^GMATDifficultyEstimate; GMATDifficultyEstimate.cls 

Fonn=frmAbout,frm 

Form=frmNew . frm 

Formes tring.frm 

Class=SubString; SubString.cls 

Class=ConstraintSolver; ConstraintSolver.cls 

Class=StringSolver; StringSolver.cls 

Class^Value; Value.cls 

Class=PrintModel; PrintModel.cls 

Module=MTAPI; MTAPLbas 

Module=MTDeclarations; MTDeclarations.bas 

Module^MTUtil; MTUtil.bas 

Form=frmProlog.frm 

ResFile32='Tca.res" 

IconForm-'TrmTCA" 

Startup="Sub Main" 

HelpFile='"' 

Title="TCA" 

ExeName32-"TCA.exe" 

Command32-"" 

Name='Trojectl" 

HelpContextID="0" 

CompatibleMode-"0" 

MajorVer=0 

MinorVer=l 

RevisionVer=145 

Autolncrement Ver= 1 

ServerSupportFiles^O 

VersionCompanyName="ETS" 

CompilationType=0 

OptimizationType=2 

FavorPentiumPro(tm)=0 

CodeViewDebuglnfo^O 

NoAliasing=0 

BoundsCheck^O 

OverflowCheck=0 

FlPointCheck=0 

FDIVCheck-0 

UnroundedFP=0 



VBSCA -2- 



StartMode=0 

Unattended=0 

Retained^O 

ThreadPerObject=0 

MaxNumberOfThreads=l 



' AXProlog.vbp 
Type=01eExe 

Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#.A.A.A.AWINNT\System32\ 
STD0LE2.TLB#0LE Automation 

Reference=nG{3D5C6BF0-69A3-llD0-B393-00A0C9055D8E}#L0#0#.A.A,ACommon 

Files\designer\MSDERUN.DLL#Microsoft Data Environment Instance LO 

Reference=*\G{00000200-0000-0010-8000-00AA006D2EA4}#2.0#0#.A.A.ACommon 

Files\system\ado\msado20.tlb#Microsoft ActiveX Data Objects 2.0 Library 

Class=Prolog; Prolog.cls 

Module=Modulel; Timer.bas 

Class=File; File. els 

Startup="(None)" 

HelpFile-"" 

ExeName32=" AXProlog.exe*' 

Command32="" 

Name="AXProlog" 

HelpContextID="0" 

CompatibleMode-"!" 

CompatibleEXE32=" AXProlog.exe" 

MajorVer^l 

MinorVer=0 

RevisionVer=0 

AutoIncrementVer^O 

ServerSupportFiles^O 

VersionCompanyName="ETS" 

CompilationType^O 

OptimizationType=0 

FavorPentiumPro(tm)=0 

CodeViewDebugInfo=0 

NoAliasing=^0 

BoundsCheck=0 

OverflowCheck=0 

FlPointCheck=0 

FDIVCheck=0 

UnroundedFP=0 

StartMode=l 

Unattended^- 1 

Retained^O 

ThreadPerObject--l 

MaxNumberOfThreads= 1 

DebugStartupOption=0 
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' Common.bas 

Attribute VB Name = "Common" 
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' Main.bas 

Attribute VB_Name = "StartUp" 
Option Explicit 

Public Const READ_UNTIL_EOF = 0 

Public Const INI_DIRECTORY = "C:\TCS\TCA\OUT\TCAOUT.INI" 
Public Const IN_DIRECTORY - "C:\TCS\TCA\IN\" 
Public Const OUT_DIRECTORY = "C:\TCS\TCA\OUT\" 
Public Const LOCKEDJTEM_NAME = "TCATEMP.DOC" 
Public Const LVM_FIRST = &H1000 

Public Const LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 54 
Public Const LVM_GETEXTENDEDLISTVIEWSTYLE = LVM__FIRST + 55 
Public Const LVS_EX_FULLROWSELECT = &H20 
Public Const HALT_FN = "C:\HALT.TCA" 

Public Const STR1NG_DELIMITER = 164 

Private Sub Main() 

Dim MyApp As New TCAApplication 

If App.PrevInstance Then 

Call MsgBox("Only one instance of TCA may be run at a time!", _ 
vbExclamation, "Error") 

Exit Sub 
End If 

' 10 seconds for component timeout 
App.OleRequestPendingTimeout = 10000 

MyApp .Run 

End Sub 
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' modUtilbas 

Attribute VB_Name - "Util" 
Option Explicit 

' Capitalizes the first letter of a string if it's a lower case letter 
Sub CapitalizeString(strInput As String) 

Dim strl, str2 As String 
Dim intStrLen As Integer 

intStrLen = Len(strlnput) 

If(intStrLen>0) Then 

strl = UCase(left(strInput, 1)) 
End If 

If (intStrLen > 1) Then 

str2 = right(strlnput, intStrLen - 1) 
End If 

strlnput =^ strl & str2 
End Sub 

' Selects contents of text box for easy editing 
Sub txtSelectAll(txtTextBox As TextBox) 

' Automatically select all text 
txtTextBox.SelStart - 0 
txtTextBox.SelLength = Len(txtTextBox.Text) 

End Sub 

' Checks to see if a file exists 

Function FileExists(ByVal strFN As String) As Boolean 

Dim intFNum As Integer 

' Get the file number 
intFNum =^ FreeFile 

' Open the file and trap any errors 
On Error GoTo NotFound 
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Open strFN For Binary Access Read As #intFNum 
On Error GoTo 0 

Close #intFNum 

FileExists = True 
Exit Function 

NotFound: 

' Close the file 
Close #intFNum 
FileExists = False 
Exit Function 

End Function 

' extracts the path from a path/filename string 

Function ExtractPath(ByVal strFN As String) As String 

Dim varll As Variant 
Dim varI2 As Variant 

' find the last "\" in the string 

varll = 0 

Do 

varI2 = varll 

varll - InStr(varI2 + 1, strFN, "\") 
Loop Until varll = 0 

ExtractPath = Mid(strFN, 1, varI2) 

End Function 

' extracts the file name from a path/filename string 

Function ExtractFileName(By Val strFN As String) As String 

Dim varll As Variant 
Dim varI2 As Variant 

' find the last "\" in the string 

varll =0 

Do 
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varI2 = varll 

varll = InStr(varI2 + 1, strFN, "\") 
Loop Until varll = 0 

ExtractFileName = Mid(strFN, varI2 + 1, Len(strFN) - varI2) 
End Function 

' extracts the file name sans extension from a path/filename string 
Function ExtractFileNameNoExt(By Val strFN As String) As String 

StrFN = ExtractFileName(strFN) 

Dim varll As Variant 
Dim varI2 As Variant 

' find the last "." in the string 

varll = 0 

Do 

varI2 = varll 

varll = InStr(varI2 + 1, strFN, ".") 
Loop Until varll = 0 

ExtractFileNameNoExt = Mid(strFN, 1, varI2 - 1) 
End Function 

' extracts the family name - everything up to $R 

Function ExtractFamilyName(ByVal strFN As String) As String 

StrFN = ExtractFileName(strFN) 

Dim varl As Variant 

' find "$R" in the string 
varl = InStr(l, StrFN, "$R") 

If varl > 0 Then 

ExtractFamilyName = Mid(strFN, 1, varl - 1) 

End If 

End Function 

' extracts the key, meaning $R and everthing up to the . 
Function ExtractFamilyKey(ByVal strFN As String) As String 
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strFN - ExtractFileName(strFN) 

Dim varl As Variant 
Dim varll As Variant 
Dim varI2 As Variant 

' find "$R" in the string 
varl = InStr(l, StrFN, "$R") 

' find the last in the string 

varll = 0 

Do 

varI2 = varll 

varll = InStr(varI2 + 1, strFN, 
Loop Until varll = 0 

ExtractFamilyKey = Mid(strFN, varl, varI2 - varl) 
End Function 

' trim nulls off the end of a string 

Function TrimAtFirstNull(ByVal strS As String) As String 

Dim varl As Variant 

varI = InStr(l,strS, Chr(O)) 
TrimAtFirstNull = left(strS, varl - 1) 

End Function 

' returns a string with all instances of strFrom replaced 
' with strTo in string strS 

Function Rep lace All(ByVal strS As String, ByVal strFrom As String, 
ByVal strTo As String) As String 

Dim varl As Variant 
Dim intL As Integer 

Do 

varl = InStr(l, strS, strFrom) 
If varl > 0 Then ' found strFrom 
intL = Len(strS) 

StrS - left(strS, varl - 1) & strTo & _ 
right(strS, intL - Len(strFrom) - varl + 1) 
End If 
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Loop Until varl = 0 
ReplaceAU = strS 
End Function 

' returns the name of indexed string variables 
Function GetIndexedName(ByVal strName As String, _ 
ByVal inti As Integer) As String 

GetlndexedName = strName & "." & Trim(Str(intI)) 
End Function 

' Prolog shuts down when this file is created 
Sub CreateKillFileO 

Open HALT_FN For Output As #10 
Print #10, "Halt!" 
Close #10 

End Sub 

' Delete the kill file 
Sub DestroyKillFileO 

On Error Resume Next ' if it's not there. Kill will produce 

Kill HALT FN 

err.Clear 

End Sub 



VBSCA-11- 



• MTAPI.BAS 

Attribute VB_Name = "MTAPI" 
'mtapi.bas 4.0 

' (c) Copyright 1992-1999 by Design Science, Inc. All rights reserved 
' with the exception that registered MathType owners may alter these 
' macros for use by themselves and other registered MathType owners 
' provided that: 

' 1) The alterations are summarized in a comment directly below this 
copyright notice. The comment should start with the words 

' "Modified by" and include the name of the person altering the 
macros, the date of alteration, and that person's email address 

' (if available). 

' 2) Persons ahering the macros notify Design Science of the nature 
' of any changes they have made. 

' These provisions may help us help other customers, and will help us 
' continue to provide quality products for you in the future. 



' version # of this API 

Public Const MTAPI_VERSION = 4 

' maximum length of file paths, names, etc. 
Public Const MTAPI_MAX_PATH = 260 

' Picture specifier 

PubUc Type MTAPI_PICT 

mm As Long 

xExt As Long 

yExt As Long 

hMF As Long 
End Type 

Pubhc Type RECT 

left As Long 

top As Long 

right As Long 

bottom As Long 
End Type 

' Picture dimensions 

Pubhc Type MTAPI_DIMS 
baseline As Integer ' dist of baseline from bottom (points) 
bounds As RECT ' bounding rectangle (points) 
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End Type 

' return codes from MT DLL API 

' success, no error 

Public Const mtOK = 0 

' equation OLE 1.0 object on clipboard 

Public Const mtOLE_EQUATION = 1 

' Windows metafile equation graphic (not OLE object) on clipboard 
Public Const mtWMF_EQUATION = 2 

' Macintosh PICT equation graphic (not OLE object) on clipboard 
Public Const mtMAC_PICT_EQUATION = 4 
' equation OLE 2.0 object on clipboard 
Public Const mtOLE2_EQUATION = 8 

' error return codes 

' can't find MathType application 
Public Const mtMT_NOT_FOUND = -1 
' can't run the MathType application 
Public Const mtMT_CANT_RUN = -2 
' the MathType application is the wrong version 
PubUc Const mtMT_BAD_VERSION = -3 
' the MathType application is already in use 
Pubhc Const mtMT_IN_USE = -4 

' the MathType appUcation is not running (i.e. unexpectedly aborted) 

Public Const mtMT_NOT_RUNNING = -5 

' time ran out waiting for the MathType application to start up 

Public Const mtRUN_TIMEOUT = -6 

' not equation on clipboard 

Pubhc Const mtNOT_EQUATION = -7 

' file does not exist or bad pathname 

Public Const mtFILE_NOT_FOUND = -8 

' insufficient memory 

Public Const mtMEMORY = -9 

• bad file 

Public Const mtBAD_FILE = -10 

' requested data does not exist 

Public Const mtDATA_NOT_FOUND = -1 1 

' too many server session open 

Pubhc Const mtTOO_MANY_SESSIONS = -12 

' could not perform one or more subs 

Public Const mtSUBSTITUTION_ERROR = -13 

' could not perform translation 

Pubhc Const mtTRANSLATOR_ERROR = -14 
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' could not set preferences, or invalid preference string 
Public Const mtPBlEFERENCE ERROR = -15 
' other error 

Public Const mtERROR = -9999 

' options values for MTInitAPI 

Public Const mtinitLAUNCH_AS_NEEDED = 0 

Public Const mtinitLAUNCH_NOW = 1 

' options values for MTGetTranslatorsInfo 
Public Const mttmCOUNT = 1 
Public Const mttmMAX NAME = 2 
Public Const mttmMAX_DESC = 3 
Public Const mttmMAX_FILE = 4 
Public Const mttmOPTIONS = 5 

' options values for MTXFormAddVarSub 
Public Const mtxfmSUBST_ALL = 0 
Public Const mtxfmSUBST_ONE = 1 

' find/replace types for MTXFormAddVarSub substitutions 
Public Const mtxfinVAR_SlJB_BAD = -1 
Public Const mtxfinVAR_SUB_PLAIN_TEXT = 0 
Public Const mtxfmVAR_SUB_MTEF_TEXT = 1 
Public Const mtxfmVAR_SUB_MTEF_BINARY = 2 
Public Const mtxfhiVAR_SUB_DELETE = 3 

' replace style for MTXFonnAddVarSub substitutions when replaceType 

mtxfmVAR_SUB_PLAIN_TEXT 

Public Const mtxfmSTYLE_TEXT = 1 

Public Const mtxfmSTYLE_FUNCTION = 2 

Public Const mtxfmSTYLE_VARIABLE = 3 

Public Const mtxfinSTYLE_LCGREEK = 4 

Public Const mtxfmSTYLE_UCGREEK = 5 

Public Const mtxfinSTYLE_SYMBOL = 6 

Public Const mtxfinSTYLE_VECTOR = 7 

Public Const mtxfinSTYLE_NUMBER = 8 

' options values for MTXFormSetPrefs 
Public Const mtxfmPREF_EXISTING = 1 
Public Const mtxfmPREF_MTDEFAULT = 2 
Public Const mtxfinPREF_USER = 3 
Public Const mtxftnPREF_LAST = 3 

' options values for MTXFormSetTranslator 
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Public Const mtxfmTRANSL_INC_NONE = 0 
Public Const mtxfinTRANSL_INC_NAME = 1 
Public Const mtxftnTRANSL_INC_DATA = 2 
Public Const mtxfinTRANSL_INC_MTDEFAULT = 4 

' return values from MTXFormGetStatus 
Public Const mtxfinSTAT PREF = -3 
Public Const mtxj5nSTAT_TRANSL = -2 
Public Const mtxfmSTAT_ACTUAL_LEN = -1 

' data sources/destinations for MTXFormEqn 
Public Const mtxfinPREVIOUS = -1 
Public Const mtxfmCLIPBOARD = -2 
Public Const mtxfmLOCAL = -3 

' data formats for MTXFormEqn 
Public Const mtxfinMTEF = 4 
Public Const mtxfinHMTEF = 5 
Public Const mtxfinPICT = 6 
Public Const mtxfmTEXT = 7 
Public Const mtxfinHTEXT = 8 

' option values for MTSetMTPrefs 
Public Const mtprfMODE_NEXT_EQN = 1 
Public Const mtprfMODE_MTDEFAULT = 2 
Public Const mtprfMODE_INLINE = 4 

' MT API functions 

Public Declare Function MTAPIVersion Lib "mt4" (ByVal api As Integer) As Long 

Public Declare Function MTInitAPI Lib "mt4" (ByVal options As Integer, ByVal timeout As 

Integer) As Long 

Public Declare Function MTTenn7\PI Lib "mt4" () As Long 
Public Declare Function MTClearClipboard Lib "mt4" () As Long 
Public Declare Function MTEquationOnClipboard Lib "mt4" () As Long 
Public Declare Function MTXFormReset Lib "mt4" () As Long 
Public Declare Function MTXFormAddVarSub Lib "mt4" ( _ 
ByVal options As Integer, _ 

ByVal fmdType As Integer, ByVal find As String, ByVal findLen As Long, _ 
ByVal replaceType As Integer, ByVal replace As String, ByVal replaceLen As Long, _ 
ByVal replaceStyle As Integer _ 
) As Long 

Public Declare Function MTXFormSetTranslator Lib "mt4" (ByVal options As Integer, _ 

ByVal transName As String) As Long 
Public Declare Function MTXFormSetPrefs Lib "mt4" (ByVal preflype As Integer, ByVal 
prefStr As String) As Long 
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Public Declare Function MTSetMTPrefs Lib "mt4" (ByVal mode As Integer, ByVal prefs As 
String, _ 

ByVal timeout As Integer) As Long 
Public Declare Function MTXFormEqn Lib "mt4" ( _ 

ByVal src As Integer, ByVal srcFmt As Integer, ByVal srcData As String, ByVal srcDataLen 
As Long, _ 

ByVal dst As Integer, ByVal dstFmt As Integer, ByVal dstData As String, ByVal dstDataLen 
As Long, _ 

ByRef dims As MTAPI_DIMS) As Long 
Public Declare Function MTXFormGetStatus Lib "mt4" (ByVal index As Integer) As Long 
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' MTDeclaration.bas 

Attribute VB Name = "MTDeclarations" 



'Windows API declarations 



Public Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, 
ByVal IpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long 
Public Declare Function LoadLibrary Lib "kemel32" Alias "LoadLibraryA" (ByVal 
IpLibFileName As String) As Long 

Public Declare Function FreeLibrary Lib "kemel32" (ByVal hLibModule As Long) As Long 
Public Declare Function LoadString Lib "user32" Alias "LoadStringA" (ByVal hinstance As 
Long, ByVal wID As Long, ByVal IpBuffer As String, ByVal nBufferMax As Long) As Long 
Public Declare Function GetLocalelnfo Lib "kemel32" Alias "GetLocalelnfoA" (ByVal Locale 
As Long, ByVal LCType As Long, ByVal IpLCData As String, ByVal cchData As Long) As 
Long 

Public Declare Function GetEnvironmentVariable Lib "kemel32" Alias 

"GetEnvironmentVariableA" (ByVal IpName As String, ByVal IpBuffer As String, ByVal nSize 
As Long) As Long 

Public Declare Function SetEnviromnentVariable Lib "kemel32" Alias 
"SetEnvironmentVariableA" (ByVal IpName As String, ByVal Ip Value As String) As Long 
Public Declare Function GetTickCount Lib "kemel32" () As Long 



' Constants for use in Windows API calls 



' Used by GetLocalelnfo 

' values for LCType (locale info requested) - used in MTLib.InitLocaleStrs 
Public Const Locale_SLanguage As Long = &H2 
Public Const Locale_SEngLanguage As Long = &H1001 



' Constants for use in Help calls 



Public Const hlpMSWDPreferences_Dialog =117 
Public Const hlpMSWDEquation_Number_Fomiat_Dialog = 6300 
Public Const hlpMSWDFormat_Equations_Dialog = 6500 
Public Const hlpMSWDInsert_Equation_Section_Dialog = 1 14 
Public Const hlpMSWDFormat_Equation_Section_Dialog =116 
Public Const hlpMSWDSet_Equation_Preferences_Dialog ==37 
Public Const hlpMSWDConvert_Equations_Dialog = 44 
Public Const hlpMSWDInsert_Equation_Number_Dialog =118 
Public Const hlpMSWDInsert_Requation_Ref_Dialog =119 

Public Const hlpMSWDWT_SetEqnPrefs = 122 



VBSCA-17- 



Public Const MpMSWDWT InlineEqn = 123 

Public Const lilpMSWDWT_CenteredEqn = 124 

Public Const hlpMSWDWT_CenteredNumberedEqn = 125 

Public Const hlpMSWDWT_EqnNuniber = 126 

Public Const hlpMSWDWT_EqnRef = 127 

Public Const hlpMSWDWT_EqnSec = 128 

Public Const hlpMSWDWT_ModEqnSec = 129 

Public Const hlpMSWDWT_FormatEqnNum = 130 

Public Const hlpMSWDWT_ConvertEqn =131 

Public Const hlpMSWDWT ForaiatEqn = 132 

Public Const hlpMSWDWT_UpdateEqn = 133 



' Constants for use in the MathType Commands 



• Numbers we compare against with MTAPIvers 

Public Const mtversMajVerHi = 1279 '0x04ff 
Public Const mtversMajVerLo = 1024 '0x0400 
Public Const mtversMinVer = 1 024 '0x0400 

' Registry location codes 

Public Const mtreg_MT_LANG_LOCATION As String = 

"HKEY_CURRENT_USER\Software\Design Science\DSMT4\Config" 'Registry entry for 
MathType's curent language 

Public Const mtreg_MT_LANG_KEY As String = "AppLang" 'registry key for MathType's 
curent language 

Public Const mtreg_MT_PROGDIR_LOCATION As String = 

"HKEY_LOCAL_MACHINE\SOFTWARE\Design Science\DSMT4\Directories" 'Registry 
entry for MathType's directory 

Public Const mtreg_MT_PROGDIR_KEY As String = "ProgDir" 'registry key for MathType's 
directory 

Public Const mtreg_MT_LANGUAGEDIR_LOCATION As String = 
"HKEY_LOCAL_MACHINE\SOFTWARE\DesignScience\DSMT4\Directories" 'Registry 
entry for MathType's language support files directory 

Public Const mtreg_MT_LANGUAGEDIR_KEY As String = "LastLangDir" 'registry key for 

MathType's language support files directory 

Public Const mtreg_MT_HELPDIR_LOCATION As String = 

"HKEY_LOCAL_MACHINE\SOFTWARE\DesignScience\DSMT4\Directories" 'Registry 
entry for MathType's help file directory 

Public Const mtreg MT HELPDIR KEY As String = "LastHelpDir" 'registry key for 
MathType's help file directory 

Public Const mtreg_MT_HELPFILE_LOCATION As String = 

"HKEY_ClJRRENT_USER\Software\Design Science\DSMT4\Config" 'Registry entry for 
MathType's help file name 

Public Const mtreg_MT_HELPFILE_KEY As String = "HelpFile" 'registry key for 
MathType's help file name 
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Public Const mtreg_MT_SYSTEMDIR_LOCATION As String - 

"HKEY_LOCAL_MACHINE\SOFTWARE\Design Science\DSMT4\Directories" 'Registry 
entry for MathType's system directory 

Public Const mtreg_MT_SYSTEMDIR_KEY As String = "LastAppSystemDir" 'registry key 
for MathType's system directory 

Public Const mtreg_MT_PREFDIR_LOCATION As String = 

"HKEY_LOCAL_MACHINE\SOFTWARE\DesignScience\DSMT4\Directories" 'Registry 
entry for MathType's preferences folder 

Public Const mtreg_MT_PREFDIR_KEY As String = "LastPrefsDir" 'registry key for 
MathType's system directory 

Public Const mtreg_MT_WORDCMDS_LOCATION As String = 
"HKEY_CURRENT_USER\SOFTWARE\DesignScience\DSMT4\WordCommands" 
'Registry entry for MathType's Word Commands data 

Public Const mtreg_MT_WORD_CONVFROM As String = "ConvertFrom" 'ConvertFrom 
key 

PubHc Const mtreg_MT_WORD_CONVTO As String = "ConvertTo" 'ConvertTo key 
Public Const mtreg_MT_WORD_CONVMISC As String = "ConvertMisc" 'ConvertMisc key 
PubHc Const mtreg_MT_WORD_CONVTRANS As String = "ConvertTranslator" 
'ConvertTranslator key 

Public Const mtreg_MT_WORD_DONTSHOW_EQNREFDLG As String = 
"NoInsertEqnRefDlg" 'Don't Show Insert Eqn Ref dialog key 
PubHc Const mtreg_MT_WORD_DONTSHOW_SLOWEQNUPDATE As String = 
"NoSlowUpdateEqnDlg" 'Don't Show Insert Eqn Ref dialog key 

Public Const mtreg_MT_WORD_DONTSHOW_LANGDLLERROR As String = 
"NoLanuageDLLError" 'Don't show Missing Lang DLL error key 

• Strings used in MT text equations (TeX and MathML) 

Public Const mttexteqn_START As String = "% MathType! " 'The identifier at the beginning 
of MathType translator text equations 

PubHc Const mttexteqn_END As String = "% MathType! End!" 'The identifier at the end of 
MathType translator text equations 

' Property names 

Public Const mtprop_USE_MATHTYPE_PREFS As String = "MTUseMTPrefs" 'The 
name of the Document Property that indicates to use MathType's prefs for new equations 
PubHc Const mtprop_PREFERENCES As String = "MTPreferences" 'Contains the 
doc's settings for new equations 

PubHc Const mtprop_PREFERENCES_FILE As String = "MTPreferenceSource" 'Contains 
the doc's settings for new equations 

Public Const mtprop_NUMBER_PREFS As String = "MTEquationNumber" 'Contains 
the current equation number format preferences 

Public Const mtprop_DEFER_FIELD_UPDATE As String = "MTDeferFieldUpdate" 
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'Controls field updating 

Public Const mtpropEQUATION_SECTION_CHECKED As String - "MTEquationSection" 
'Indicates if eqn section number is 0 check has been made 

Public Const mtprop_EQNREFPANE As String = "MTEqnRefPane" 'Pane number containing 
insertion point where ref is to be placed 

' AutoText entry names 

Public Const mtautotext_MT3_EQN_NlJMBER_FORMAT As String = 
"ZMTEqnNumFormatPrefs" 'The name of old Autotext entry that held MathTypeS's equation 
number format prototype 

' MathType OLE data 

Public Const mtole_PROGID As String = "Equation.DSMT4" 'OLE Prog ID used to identify 
MathType 4 

' Style names 

Public Const mtstyle_EQUATION_SECTION As String 
eqn. section names 

Public Const mtstyle_DISPLAY_EQUATION As String 
for display equations 

' Misc. constants 

'Constants used to specify 'curent selection' or 'whole document' 
Public Const mt_RANGE_DOCUMENT = 0 
Public Const mt_RANGE_S ELECTION = 1 

'Constants used by MTMsgBox 
Public Const mt_MBYESNO = 1 
Public Const mt_MBYESNOCANCEL = 2 
Public Const mt_MBYES = 1 
Public Const mt_MBNO = 2 
Public Const mt_MBCANCEL = 3 

•Flag bit for MTLib.SaveWordState() 
Public Const mt_SWS_TRACKCHANGES = 1 
PubUc Const mt_SWS_SMART_CUTPASTE = 2 
Public Const mt_SWS_TYPING_REPLACE_SELECTION = 4 



= "MTEquationSection" 'Style used for 
= "MTDisplayEquation" 'Style used 
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' MTUtil.bas 

Attribute VB_Name = "MTUtil" 
'MTUtil: 4,0 



(c) Copyright 1992-1999 by Design Science, Inc. All rights reserved 
with the exception that registered MathType owners may alter these 
macros for use by themselves and other registered MathType owners 
provided that: 

1) The alterations are summarized in a comment directly below this 
copyright notice. The comment should start with the words 
"Modified by" and include the name of the person altering the 
macros, the date of alteration, and that person's email address 

(if available). 

2) Persons ahering the macros notify Design Science of the nature 
of any changes they have made. 

These provisions may help us help other customers, and will help us 
continue to provide quality products for you in the future. 



This macro contains subroutines used by other Design Science macros 



Option Explicit 
'Public Sub Main() 

' MsgBox MTUtil.GetUserStringC ! 1 600This contains a library of functions shared by 
MathType's macros."), _ 

vbOKOnly, MTUtil.GetUserStringC'! 1601 MTUtil Macro") 
'End Sub 



CheckMTDLLVersionO 
Checks the MT DLL version. If it's a bad version, we display an 
error and return 0. If we can still run, retums nonzero 



Public Function CheckMTDLLVersionQ 
Dim errorflag 
Dim dllver 
Dim msg$ 
Dim myResult 

errorflag = 0 

CheckMTDLLVersion = 1 'assume success to start 
'init the API 
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If MTInitAPI(mtinitLAUNCH_AS_NEEDED, 30) o 0 Then 

msg$ = MTUtil.GetUserStringC'! 1606The MathType commands could not communicate 
with MathType. There was a problem starting the API. Please be sure that MathType is properly 
installed.") 

CheckMTDLLVersion = 0 
errorflag = 1 
Else 

'get the API Version 

dllver - MTAPIVersion(MTAPI_VERSION) 
'check the version against our constants 

If (dllver > mtversMajVerHi) Or (dllver < mtversMajVerLo) Then 
msg$ ^ MTUtil.GetUserStringC !1607The version of this macro doesn't match the 
version of MathType's DLL. Reinstall MathType to fix this condition.") 
CheckMTDLLVersion = 0 
errorflag = 1 
Elself (dllver < mtversMinVer) Then 

msg$ = MTUtil.GetUserStringC'! 1608 A more recent version of MathType's DLL is 
required to use this macro. Reinstall MathType to fix this condition.") 
CheckMTDLLVersion = 0 
errorflag = 1 
End If 
End If 

If (errorflag =1) Then 'report error condition 

MsgBox msg$, vbCritical, MTUtil.GetUserStringC !1609MathType Commands for 
Microsoft Word Error") 

End If 
End Function 



GetUserStringS 



Public Function GetUserString$(EnglishString$) 

'simply return the English version (strip "!nnnn" from start) 
GetUserString$ = right(EnglishString$, Len(EnglishString$) - 5) 

End Function 



GetMathTypeDir$ 
' Gets the location of MathType from the registry 

t — r=====— ^=== 

Public Function GetMathTypeDirSQ 
Dim path$ 
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'get the location of Mathtype from the registry 

path$ - System.PrivateProfileStringC'", mtreg_MT_PROGDIR_LOCATION, 
mtreg_MT_PROGDIR_KEY) 

'return the results 
GetMathTypeDir$ - path$ 
End Function 



WritePermSetting 



'Writes key/value pair to permanent location, ie Windows registry. 
'Used when data needs to be saved whose scope is larger than a document. 
Public Sub WritePermSetting(key$, data$) 

System.PrivateProfileStringC'", mtreg_MT_WORDCMDS_LOCATION, key$) = data$ 
End Sub 



ReadPermSettingS 



'Reads key's value from the permanent location, ie Windows registry. 
'Used when data needs to be saved whose scope is larger than a document. 
Public Function ReadPermSetting$(key$) 

ReadPermSettingS System.PrivateProfileString("", mtreg_MT_WORDCMDS_LOCATION, 
key$) 

End Function 



SetNextTXFormPrefs 
'Sets prefs that MathType will use for the next transformed equation. 
'Returns MTXFormSetPrefs result code. 



Function SetNextTXFormPrefs(prefStr$) 
Dim Stat 

'set preferences for next transformed equation 

Stat = MTXFormSetPrefs(mtxfmPREF_USER, prefStrS) 

If Stat oOThen 

MsgBox MTUtil.GetUserStringC'! 1 lOOTherc was a problem sending your equation 
preferences for " _ 

+ "this document to MathType. This equation will use MathType's " _ 
+ "'New Equation' preferences."), vbExclamation, _ 
MTUtil.GetUserStringC' ! 1 lOlMathType Preferences Problem") 
End If 
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SetNextTXFormPrefs = stat 
End Function 



' S etPrefsForNextEqn 

'Sets prefs that MathType will use for the next new equation. 
'Returns MTSetMTPrefs result code. 



Public Function SetPrefsForNextEqn(prefStr$, inline As Boolean) 
Dim stat 

Dim options As Integer 

options = mtprfMODE_NEXT__EQN 

If inline Then options = options + mtprfMODE_INLINE 

'set preferences for next transformed equation 

stat = MTSetMTPrefs(options, prefStr$, -1) 

IfstatoOThen 

MsgBox MTUtil.GetUserString("! llOOThere was a problem sending your equation 
preferences for " _ 

+ "this document to MathType. This equation will use MathType's " _ 
+ '"New Equation' preferences."), vbExclamation, _ 
MTUtiLGetUserStringC ! 1 1 01 MathType Preferences Problem") 
End If 

S etPrefsForNextEqn = stat 
End Function 



' IsEquationProgID 

'Returns 1 if the progID is a MathType/EE OLEl proglD. 
'Returns 2 if the progID is a MathType/EE 0LE2 proglD. 
'Retums 0 if not a recognized progID. 



Public Function IsEquationProgID(progID$) As Long 
Dim uProglDS 
uProgID$ - UCase(progID$) 

If uProgID$ = "EQUATION" Then 

IsEquationProgID = 1 
Elself InStr(l, uProglDS, "EQUATION.", vbBinaryCompare) = 1 Then 

IsEquationProgID = 2 
Else 

IsEquationProgID = 0 
End If 
End Function 



VBSCA -24- 



' TransformGraphicEquation 

'Attempts to transforai the graphic on the cUpboard into an equation. 

'Resulting format depends on how MathType has been configured by a 

'previous call to MTXFormSetTranslator. 

The transformed equation is left on the clipboard, 

'If OK, returns mtOK 

'If not an equation, or an error occurred, returns mtNOT_EQUATION 



Public Function TransformGraphicEquation() As Long 
TransformGraphicEquation = mtNOT^EQUATION 

'Use API call to check clipboard contents first 

If MTEquationOnClipboardO = mtNOT^EQUATION Then 

Exit Function 
End If 

TransformGraphicEquation = TransformEquationQ 
End Function 



' TransformEquation 

'Attempts to transform the item on the clipboard into an equation. 

'Resulting format depends on how MathType has been configured by a 

'previous call to MTXFormSetTranslator. 

'The transformed equation is left on the clipboard. 

'If OK, returns mtOK 

']f not an equation, or an error occurred, returns mtNOT_EQUATION 



Public Function TransformEquationQ As Long 
Dim Stat As Long 
Dim dummyStrlS, dummyStr2$ 
Dim dummyDims As MTAPI_DIMS 

On Error GoTo err 

Stat = mtNOT_EQUATION 

'as long as everything's OK, update the equation 
'set aside some buffers 
dummyStrlS = Space(l) 
dummyStr2$ = Space(l) 
With dummyDims 

.baseline = 0 

.bounds.bottom ^ 0 

.bounds. left = 0 

.bounds.right - 0 
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.bounds, top = 0 
End With 

'do the update 

Stat = MTXFormEqn(mtxfinCLIPBOARD, mtxfmTEXT, dummyStrl$, 1, _ 
mtxfmCLIPBOARD, mtxfmTEXT, dummyStr2$, 1, dummyDims) 

If Stat <0 Then 

Stat = mtNOT_EQUATION 

End If 

GoTo Bye 

err: 

If err.Number - 5690 Or err.Number = 4198 Then 

'the user has revisions on, and this is an old revision that has been deleted 

Stat - -2 

Resume Bye 
Else 

err.Raise err.Number 
Stop 
End If 
Bye: 

TransformEquation = stat 
End Function 



DeleteDocProperty 



'deletes document property, OK to call if it doesn't exist 
Public Function DeleteDocProperty(doc As Document, prop$) 
On Error GoTo Error 

doc.CustomDocumentProperties(prop$).Delete 
Error: 

End Function 



DocPropertyExists 



'returns True if the active document contains the custom doc property 
Public Function DocPropertyExists(propName$) As Boolean 
Dim name$ 

DocPropertyExists = False 
On Error GoTo Error 

nameS = ActiveDocument.CustomDocumentProperties(propName$).name 
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DocPropertyExists = True 
Error: 

End Function 



Delay 

'Pauses execution for timeout (in milliSecs) 



Public Sub Delay(timeout As Long) 
Dim start As Long 
start ^ GetTickCountO 

Do While (GetTickCountQ < (start + timeout)) 

DoEvents ' Yield to other processes. 
Loop 
End Sub 
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' Timer.bas 

Attribute VB_Name = "Module 1" 
Option Explicit 

Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, _ 

ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal IpTimerProc As Long) 
As Long 

Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, _ 
ByVal nIDEvent As Long) As Long 

Public gProlog As Prolog 
Public gTimerlD As Long 



' called by SolveConstraintsRandomly in Prolog.cls 
Public Sub SolveAsyncO 

' calls TimerCallback when timer runs out (it's set for 0, so it 
' runs out immediately. TimerCallback, and anything called by 
' TimerCallback, run async. 

gTimerlD = SetTimer(0, 0, 1000, AddressOf TimerCallback) 
End Sub 

Public Sub TimerCallback(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As 
Long, ByVal dwTime As Long) 

KillTimer 0, gTimerlD 

gProlog.SolveConstraintsAsync ' in Prolog.cls 



End Sub 
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' Contraint.frm 
VERSION 5.00 

Object = "{BDC217C8-ED16-1 1CD-956C-OOOOC04E4COA}#1.1#0"; "TABCTL32.0CX" 
Begin VB.Fortn frmConstraints 
BorderStyle = 4 'Fixed ToolWindow 
Caption = "Create or Change Constraints" 
ClientHeight = 6405 
ClientLeft = 45 
ClientTop = 285 
ClientWidth = 6285 
LinkTopic = "Forml" 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 6405 
ScaleWidth = 6285 
ShowInTaskbar = 0 'False 
StartUpPosition = 1 'CenterOwner 
Begin TabDlg.SSTab sstConstraintTool 

Height = 3375 

Left = 240 

Tablndex = 5 

Top = 1080 

Width = 4455 

_ExtentX = 7858 

_ExtentY = 5953 

_Version = 393216 

TabHeight = 520 

BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851 } 

Name = "MS Sans Serif 

Size = 8.25 

Charset = 0 

Weight = 400 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 

TabCaption(O) = "Operators" 
TabPicture(O) = "Constraint.frx":0000 
Tab(0).ControlEnabled= -1 'True 
Tab(0).Control(0)= "cmdElself 
Tab(0).Control(0).Enabled= 0 'False 
Tab(0).Control(l)= "cmdElse" 
Tab(0).Control(l).Enabled= 0 'False 
Tab(0).Control(2)= "cmdThen" 
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Tab(0).Control(2).Enabled= 0 'False 
Tab(0).Control(3)= "cmdlf 
Tab(0).Control(3).Enabled= 0 'False 
Tab(0).Control(4)= "cmdLessThanOrEqualTo" 
Tab(0).Control(4).Enabled= 0 'False 
Tab(0).Control(5)= "cmdGreaterThanEqualTo" 
Tab(0).Control(5).Enabled= 0 'False 
Tab(0).Control(6)= "cmdLessThan" 
Tab(0).Control(6).Enabled= 0 'False 
Tab(0).Control(7)= "cmdGreaterThan" 
Tab(0).Control(7).Enabled= 0 'False 
Tab(0).Control(8)= "cmdNotEqual" 
Tab(0).Control(8).Enabled= 0 'False 
Tab(0).Control(9)= "cmdAbs" 
Tab(0).Control(9).Enabled- 0 'False 
Tab(0).Control(10)= "cmdFactorial" 
Tab(0).Control(10).Enabled= 0 'False 
Tab(0).Control(l 1 )= "cmdExponent" 
Tab(0).Control(ll).Enabled= 0 'False 
Tab(0).Control(12)= "cmdQuotient" 
Tab(0).Control(12).Enabled= 0 'False 
Tab(0).Control(13)= "cmdList" 
Tab(0).Control(13).Enabled= 0 'False 
Tab(0).Control(14)= "cmdModulus" 
Tab(0).Control(14).Enabled= 0 'False 
Tab(0).Control(15)- "cmdEqual" 
Tab(0).Control(15).Enabled= 0 'False 
Tab(0).Control(16)= "cmdDivide" 
Tab(0).Control(16).Enabled= 0 'False 
Tab(0).Control(17)= "cmdMultiply" 
Tab(0).Control(17).Enabled= 0 'False 
Tab(0).Control(18)= "cmdMinus" 
Tab(0).Control(18).Enabled= 0 'False 
Tab(0).Control(19)= "cmdPlus" 
Tab(0).Control(19).Enabled= 0 'False 
Tab(0).Control(20)= "cmdParens" 
Tab(0).Control(20).Enabled= 0 'False 
Tab(0).ControlCoimt= 21 
TabCaption(l) = "Variables" 
TabPicture(l) = "Constraint.frx":OOIC 
Tab(l).ControlEnabled= 0 'False 
Tab(l).Control(0)= "cboVariableNames" 
Tab(l).Control(0).EnabIed= 0 'False 
Tab(l).Control(l)= "cmdInsertVN" 
Tab(l).Control(l).Enabled= 0 'False 
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Tab(l).ControlCount= 2 
TabCaption(2) = "Functions" 
TabPicture(2) = "Constraint.&x":0038 
Tab(2).ControlEnabled= 0 'False 
Tab(2).Control(0)= "cboFunction" 
Tab(2).Control(0).Enabled= 0 'False 
Tab(2).Control( 1 "cmdInsertFunction" 
Tab(2).Control(l).Enabled= 0 'False 
Tab(2).ControI(2)= "txtFunctionDescription" 
Tab(2).Control(2).Enabled= 0 'False 
Tab(2).ControlCount= 3 
Begin VB.CommandButton cmdParens 
Caption = "()" 
BeginProperty Font 

Name = "MS Sans Serif 

Size = 9.75 

Charset = 0 

Weight = 400 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 



EndProperty 




Height 


375 


Left 


2280 


Tablndex 


= 32 


ToolTipText 


= "List' 


Top = 


1320 


Width 


495 



End 

Begin VB.ComboBox cboFunction 
Height = 315 
ItemData = "Constraint.frx":0054 
Left = -74400 

List = "Constraint.frx":007C 

Style = 2 'Dropdown List 
Tablndex = 31 

ToolTipText = "Select a Prolog fimction from the list." 
Top = 840 

Width =2175 
End 

Begin VB.CommandButton cmdInsertFunction 
Caption = "Insert" 
Height = 315 
Left = -72120 

Tablndex = 30 
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ToolTipText = "Click here to insert tiiis function into the constraint above at the current 
cursor position." 

Top = 840 

Width = 855 
5 End 

Begin VB.TextBox txtFunctionDescription 
Height = 1455 
Left = -74400 
Locked = -1 'True 
10 MultiLine = -1 'True 

ScrolIBars = 2 'Vertical 
Tablndex = 29 

ToolTipText = "The description of the function appears in this window." 
Top = 1320 

15 Width = 3135 

End 

Begin VB.ComboBox cboVariableNames 
Height - 315 
ItemData = "Constraint.frx":OOEF 
M Left = -74400 

m List = "Constraint.frx":0117 

yi Style = 2 'Dropdown List 

i= Tablndex = 28 

y;] ToolTipText = "Select a Prolog function fi-om the list." 

21= Top = 1320 

^3 Width = 2175 

L End 

-~f Begin VB.CommandButton cmdInsertVN 

2f Caption = "Insert" 

3&;' Height = 315 

P5 Left = -72120 

Pi Tablndex = 27 

ToolTipText = "Click here to insert this variable name into the constraint above at the 
current cursor position." 
35 Top = 1320 

Width = 855 
End 

Begin VB.CommandButton cmdPlus 
Caption = "+" 
40 BeginProperty Font 

Name = "MS Sans Serif 

Size = 9.75 
Charset = 0 
Weight = 400 
45 Underline = 0 'False 
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Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
Height = 375 
5 Left = 480 

Tablndex = 25 
ToolTipText = "Plus" 
Top = 840 

Width = 495 
10 End 

Begin VB.CommandButton cmdMinus 
Caption = "-" 
BeginProperty Font 
Name = "MS Sans Serif ' 
15 Size = 9.75 

Charset = 0 
Weight = 400 
Underline - 0 'False 
Italic = 0 'False 
2gj Strikethrough = 0 'False 

ni EndProperty 
01 Height = 375 

J! Left = 1080 

m Tablndex = 24 

2|" ToolTipText = "Minus" 

Top = 840 

1., Width = 495 

H End 

~; Begin VB.CommandButton cmdMultiply 

3|;- Caption = "*" 

~== BeginProperty Font 

P5 Name = "MS Sans Serif 

Size = 9.75 
Charset = 0 
35 Weight = 400 

Underline = 0 'False 
Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
40 Height = 375 

Left = 1680 
Tablndex = 23 
ToolTipText = "Multiply" 
Top = 840 

45 Width = 495 
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End 

Begin VB.CommandButton cmdDivide 
Caption = 7" 
BeginProperty Font 
5 Name = "MS Sans Serif ' 

Size = 9.75 
Charset = 0 
Weight = 400 
Underline = 0 'False 
10 Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 
Height = 375 
Left = 2280 
15 Tablndex = 22 

ToolTipText = "Divide" 
Top = 840 

Width = 495 
p. End 
20=i Begin VB.CommandButton cmdEqual 

JI Caption = 

Ol BeginProperty Font 

i; Name = "MS Sans Serif ' 

m Size = 9.75 

2i= Charset = 0 

Weight = 400 
Underline = 0 'False 
5 Italic = 0 'False 

2f Strikethrough = 0 'False 

3b' EndProperty 

Height = 375 
=5 Left = 480 

Tablndex = 21 
ToolTipText = "Equals" 
35 Top - 1800 

Width = 495 
End 

Begin VB.CommandButton cmdModulus 
Caption = "%" 
40 BeginProperty Font 

Name = "MS Sans Serif ' 

Size = 9.75 
Charset = 0 
Weight = 400 
45 Underline = 0 'False 
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Italic - 0 'False 
Strikethrough = 0 'False 
EndProperty 
Height = 375 
5 Left = 2880 

Tablndex = 20 
ToolTipText = "Modulo" 
Top = 840 

Width = 495 
10 End 

Begin VB.CommandButton cmdList 
Caption = "([1,2])" 
BeginProperty Font 
Name = "MS Sans Serif 

15 Size = 9.75 

Charset = 0 
Weight - 400 
Underline = 0 'False 
Italic = 0 'False 
2|-J Strikethrough = 0 'False 

m EndProperty 
m Height = 375 

J:: Left = 2880 

€l Tablndex = 19 

21= ToolTipText = "List" 

Top = 1320 

Width = 1095 
il End 

=f Begin VB.CommandButton cmdQuotient 

3b: Caption = "\" 

■=== BeginProperty Font 

f=; Name = "MS Sans Serif ' 

Size = 9.75 
Charset = 0 
35 Weight = 400 

Underline = 0 'False 
ItaUc = 0 'False 
Strikethrough = 0 'False 
EndProperty 
40 Height = 375 

Left = 480 
Tablndex = 18 
ToolTipText = "Quotient" 
Top = 1320 

45 Width = 495 
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End 

Begin VB.CommandButton cmdExponent 
Caption = 
BeginProperty Font 
5 Name = "MS Sans Serif 

Size = 9.75 
Charset = 0 
Weight = 400 
Underline = 0 'False 
10 Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 
Height = 375 
Left = 3480 
15 Tablndex = 17 

ToolTipText = "Exponent" 
Top = 840 

Width - 495 
r== End 
20i Begin VB.CommandButton cmdFactorial 

m Caption = "!" 

01 BeginProperty Font 

4: Name = "MS Sans Serif ' 

Size = 9.75 

2§S Charset = 0 

Weight = 400 
Underline = 0 'False 
Italic = 0 'False 
S[ Strikethrough = 0 'False 

301 EndProperty 

Height = 375 
E Left = 1080 

Tablndex = 16 
ToolTipText = "Factorial" 
35 Top = 1320 

Width = 495 
End 

Begin VB.CommandButton cmdAbs 
Caption = "| |" 
40 BeginProperty Font 

Name = "MS Sans Serif ' 

Size = 9.75 
Charset = 0 
Weight = 400 
45 Underline = 0 'False 
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Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
Height = 375 
5 Left = 1680 

Tablndex = 15 
ToolTipText = "Absolute value" 
Top = 1320 

Width = 495 
10 End 

Begin VB.CommandButton cmdNotEqual 
Caption = "=/=" 
BeginProperty Font 
Name = "MS Sans Serif ' 
15 Size = 9.75 

Charset = 0 
Weight = 400 
Underline = 0 'False 
f=. Italic = 0 'False 

2l Strikethrough = 0 'False 

o1 EndProperty 
yi Height - 375 

4=: Left = 1080 

€i Tablndex = 14 

2f ToolTipText = "Does not equal" 

S Top = 1800 

L. Width = 495 

% End 

J| Begin VB.CommandButton cmdGreaterThan 

M Caption = ">" 

n BeginProperty Font 

O Name = "MS Sans Serif ' 

Size = 9.75 
Charset = 0 
35 Weight = 400 

Underhne = 0 'False 
Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
40 Height = 375 

Left = 1680 
Tablndex = 13 
ToolTipText = "Greater than" 
Top = 1800 

45 Width = 495 
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End 

Begin VB.CommandButton cmdLessThan 
Caption = "<" 
BeginProperty Font 

Name = "MS Sans Serif 

Size = 9.75 

Charset = 0 

Weight = 400 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 



EndProperty 




Height 


375 


Left 


2280 


Tablndex 


= 12 


ToolTipText 


= "Less than' 


Top = 


1800 


Width 


■ 495 



End 

Begin VB.CommandButton cmdGreaterThanEqualTo 
Caption = ">=" 
BeginProperty Font 

Name = "MS Sans Serif ' 

Size = 9.75 

Charset = 0 

Weight - 400 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 
Height = 375 
Left = 2880 
Tablndex = 11 

ToolTipText = "Greater than or equal to" 
Top = 1800 

Width = 495 
End 

Begin VB.CommandButton cmdLessThanOrEqualTo 
Caption = "<=" 
BeginProperty Font 

Name = "MS Sans Serif 

Size = 9.75 

Charset = 0 

Weight = 400 

Underhne = 0 'False 
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Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
Height = 375 
5 Left = 3480 

Tablndex = 10 

ToolTipText = "Less than or equal to" 
Top = 1800 

Width = 495 
10 End 

Begin VB.CommandButton cmdif 
Caption = "if 
BeginProperty Font 
Name = "MS Sans Serif ' 
15 Size = 9.75 

Charset - 0 
Weight = 400 
Underline = 0 'False 
n Italic = 0 'False 

2Qi Strikethrough = 0 'False 

01 EndProperty 
111 Height = 375 

4= Left = 480 

J== Tablndex = 9 

2i;= ToolTipText = "If 

Top = 2280 

L Width = 735 

% End 

fi Begin VB.CommandButton cmdThen 

35 Caption = "then" 

n BeginProperty Font 

5 Name = "MS Sans Serif 

Size = 9.75 
Charset = 0 
35 Weight = 400 

Underline = 0 'False 
Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
40 Height = 375 

Left = 1320 

Tablndex = 8 
ToolTipText = "then" 
Top = 2280 

45 Width =735 
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3 



End 

Begin VB.CommandButton cmdElse 
Caption = "else" 
BeginProperty Font 
5 Name = "MS Sans Serif 

Size - 9.75 
Charset = 0 
Weight = 400 
Underline = 0 'False 
10 Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 
Height = 375 
Left =2160 
15 Tablndex = 7 

ToolTipText = "else" 
Top = 2280 

Width = 735 
Q End 
203 Begin VB.CommandButton cmdElself 

ai Caption = "elseif 

U1 BeginProperty Font 

£ Name = "MS Sans Serif 

I; Size = 9.75 

2£ Charset = 0 

Weight = 400 
Underline = 0 'False 
Jj Italic = 0 'False 

?5 Strikethrough = 0 'False 

3gi EndProperty 
f] Height = 375 

C Left = 3000 

Tablndex = 6 
ToolTipText = "elseif 
35 Top = 2280 

Width = 975 
End 
End 

Begin VB.TextBox txtConstraint 
40 Height = 315 

Left = 240 

Tablndex = 3 

ToolTipText = "Enter the constraint here." 
Top = 480 

45 Width = 4455 



VBSCA -40- 



3 



3 



9 



End 

Begin VB.TextBox txtComment 
Height = 1335 
Left = 240 
5 MultiLine = -1 'True 

Tablndex = 0 
Top = 4800 

Width = 4455 
End 

10 Begin VB.CommandButton cmdConOK 

Caption = "OK" 
Default = -1 'True 
Height = 495 
Left = 4920 

15 Tablndex = 1 

ToolTipText = "Click here to save this constraint." 
Top = 120 

Width = 1215 

• a End 

2Qj Begin VB.CommandButton cmdConCancel 
0^ Caption = "Cancel" 

W Height = 495 

f Left = 4920 

• Tablndex = 2 

2 J-i ToolTipText = "Click here to return without creating or modifying this constraint." 

Top = 720 

P5 Width = 1215 

i End 

Begin VB.Label IblComment 
Caption = "Comment" 
Height = 255 
Left = 240 
Tablndex = 26 
Top = 4560 

Width = 1215 
End 

Begin VB.Label IblConstraints 
Caption = "Constraint" 
Height = 255 
40 Left = 240 

Tablndex = 4 

ToolTipText = "Click on the down arrow for function prototypes" 
Top = 240 

Width = 1695 
45 End 
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End 

Attribute VB_Name = "frmConstraints" 
Attribute VB_GlobalNaineSpace = False 
Attribute VB__Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 

Private mbytAddEditFIag As Byte 
Private mIstListBox As ListBox 
Private mudtCon As Constraint 
Private mudtModel As Model 
Private mudtConType As ConstraintType 

Private Enum ResourceStrings 

rcStartFunctions = 101 

rcEndFunctions ^125 

rcStartExplanations = 201 
End Enum 

Private mblnChangeFocus As Boolean 

Public Property Let AddEditFlag(ByVal bytNew Value As Byte) 

mbytAddEditFIag = bytNew Value 
End Property 

Public Property Let ListBox(ByVal IstNewValue As ListBox) 

Set mIstListBox = IstNewValue 
End Property 

Public Property Let Constraint(ByVal udtNewValue As Constraint) 

Set mudtCon = udtNewValue 
End Property 

Public Property Let ConstraintType(ByVal udtNewValue As ConstraintType) 
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mudtConType = udtNewValue 



End Property 

Public Property Let Model(ByVal udtNewValue As Model) 

Set mudtModel = udtNewValue 
End Property 

Private Sub cboFunction_Click() 
Dim inti As Integer 

For intI = 0 To cboFunction.ListCount - 1 
If cboFunction ^ cboFunctionXist(intl) Then 

txtFunctionDescription = LoadResString(intI + rcStartExplanations) 
Exit For 
End If 
Next intI 

If mblnChangeFocus Then 

txtConstraint.SetFocus 
End If 

End Sub 

Private Sub cboVariableNames_Click() 

If mblnChangeFocus Then 

txtConstraint.SetFocus 
End If 

End Sub 

Private Sub cmdElse_CHck() 

Call InsertTextC'else", 0) 
End Sub 

Private Sub cmdElseIf_Chck() 
Call InsertTextC'elseif 0) 
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End Sub 

Private Sub cmdGreaterThan_Click() 

Call InsertText(">", 0) 
End Sub 

Private Sub cmdGreaterThanEqualTo_Click() 

Call InsertText(">=", 0) 
End Sub 

Private Sub cmdIf_Click() 

Call InsertTextC'if , 0) 
End Sub 

Private Sub cmdParens_Click() 

Call InsertTextC'O", 1) 
End Sub 

Private Sub cmdThen_Click() 

Call InsertTextC'then", 0) 
End Sub 

Private Sub cmdInsertFunction_Click() 

If cboFunction = "brandomQ" Or cboFunction = "randomQ" Then 

Call InsertText(cboFunction, 0) 
Else 

Call InsertText(cboFunction, 1) 
End If 

End Sub 

Private Sub cmdInsertVN_Click() 
Call InsertText(cboVariableNames, 0) 
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End Sub 

Private Sub cmdLessThan_Click() 

Call InsertText("<") 
End Sub 

Private Sub crndLessThanOrEqualTo ClickQ 

Call InsertText("<=", 0) 
End Sub 

Private Sub cmdNotEqual_ClickO 

Call InsertText("-/=", 0) 
End Sub 

Private Sub cmdPlus_Click() 

Call InsertText("+") 
End Sub 

Private Sub cmdMinus_Click() 

Call InsertTextC'-") 
End Sub 

Private Sub cmdMultiply_ClickO 

Call InsertTextC'*") 
End Sub 

Private Sub cmdDivide_Click() 

Call InsertTextC'/") 
End Sub 



Private Sub cindModulus_Click() 

Call InsertText("%") 
End Sub 

Private Sub cmdEqual_ClickO 

Call InsertText("=") 
End Sub 

Private Sub cmdList_Click() 

Call InsertText("([])", 2) 
End Sub 

Private Sub cmdQuotient_ClickO 

Call InsertText("\") 
End Sub 

Private Sub cmdExponent_Click() 

Call InsertTextC'^") 
End Sub 

Private Sub crndFactorial ClickQ 

CalllnsertTextC'!") 
End Sub 

Private Sub cmdAbs_Click() 

CalllnsertTextC' 11", 1) 
End Sub 

Private Sub InsertText(ByVal strlnsertedText As String, 
Optional ByVal intOffset As Integer = -1) 
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Dim strFront As String 
Dim strBack As String 

If intOffset = -1 Then intOffset = Len(strlnsertedText) - 1 

StrFront = left(txtConstraint, txtConstraint.SelStart) 
StrBack = right(txt Constraint, Len(txtConstraint) - 
txtConstraint.SelStart - txtConstraint.SelLength) 

txtConstraint = strFront & strlnsertedText & strBack 
txtConstraint.SetFocus 

' move the cursor 

txtConstraint.SelStart = Len(strFront) + Len(strlnsertedText) - intOffset 
End Sub 

Private Sub Command3_Click() 
End Sub 

Private Sub Form_Load() 

' disable OK button if changes aren't allowed 
If mudtModel.IsFrozen Then 

cmdConOK.Enabled = False 
Else 

cmdConOK.Enabled = True 
End If 

Dim udtV As Variable 

' load variable names into combo box 

cbo Vari ableNames .Clear 

For Each udtV In mudtModel.Variables 

Call cboVariableNames.Addltem(udtV.name) 
Next udtV 

If mbytAddEditFlag - aeEdit Then 

txtConstraint = mudtCon.ConstraintString 

txtComment = mudtCon. Comment 
End If 

'load functions into combo box 
Dim inti As Integer 
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For inti = rcStartFunctions To rcEndFunctions 

cboFunction.List(intI - rcStartFunctions) = LoadResString(intl) 
Next intI 

mblnChangeFocus ^ False 

If cboVariableNames.ListCount > 0 Then 

cboVariableNamesXistlndex ^ 0 
End If 

cboFunction.Listlndex = 0 
mblnChangeFocus = True 

End Sub 

Private Sub cmdConOK_Click() 

If Len(txtConstraint) = 0 Then 

Call MsgBox("Null constraints are not permitted", vbExclamation, "Error") 

Exit Sub 
End If 

If mbytAddEditFlag aeEdit Then ' we're editing an old one 
' update the constraint with new data from the form 
Call mudtCon,Update(txtConstraint, mudtConType, txtComment) 
' update the text in the list box 

mlstListBox.List(mlstListBoxXistlndex) = mudtCon.ConstraintString 
Else 

' Add the new constraint 

Set mudtCon = mudtModel,Constraints.Add(txtConstraint, True, _ 

mudtConType, txtComment) 
With mlstListBox 

' Add the new constraint to the list box 

Call .Addltem(mudtCon.ConstraintString) 

' Set ItemData to index value of the variable object 

TtemData(.ListCount - 1) = mudtCon.index 

' Check the check box 

.Selected(.ListCount - 1) = True 
End With 
End If 

Call frmTCA.AddUndefmedVariables(txtConstraint) 
Unload Me 
End Sub 



VBSCA -48- 



Private Sub cmdConCancel_Click() 

Unload Me 
End Sub 



' EditConstraint.fim 

VERSION 5.00 

Begin VB.Form frmEditText 

BorderStyle = 1 'Fixed Single 

ClientHeight = 1455 

ClientLeft = 45 

ClientTop =330 

ClientWidth = 4785 

LinkTopic - "Forml" 

MaxButton = 0 'False 

Minfiutton = 0 'False 

ScaleHeight = 1455 

ScaleWidth = 4785 

StartUpPosition = 3 'Windows Default 

Begin VB.CommandButton cmdEditTextOK 



Caption 


= "OK" 


Default 


= -1 'True 


Height 


= 495 


Left 


= 3360 


Tablndex 


= 2 


Top 


= 120 


Width 


= 1215 



End 

Begin VB.CommandButton cmdEditTextnCancel 

Caption = "Cancel" 

Height = 495 

Left = 3360 

Tablndex = 1 

Top = 720 

Width = 1215 
End 

Begin VB.TextBox txtEditText 

Ahgnment = 2 'Center 

Height = 375 

Left = 240 

Tablndex = 0 

Top = 120 

Width = 2895 
End 
End 

Attribute VB_Name = "frmEditText" 
Attribute VBGlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB Predeclaredld = True 
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Attribute VB_Exposed = False 
Option Explicit 

' These are used as references to the ListBox in frmTCA currently being editted 
Pubhc IstListBox As ListBox 
5 PubHc intind As Integer 

Private Sub cmdEditTextnCancel_CHck() 

Unload Me 
End Sub 

Private Sub cmdEditTextOK_CUck() 
1 0 IstListBox. Addltem txtEditText.Text 

IstListBox.Removeltem intind 

Unload Me 
End Sub 
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' Forml.frm 
VERSION 5.00 
Begin VB.Form Forml 
Caption "Forml" 
ClientHeight = 4050 
ClientLeft = 60 
ClientTop = 345 
ClientWidth = 5595 
LinkTopic = "Forail" 
ScaleHeight = 4050 
ScaleWidth = 5595 
StartUpPosition = 3 'Windows Default 
Begin VB.CommandButton Command 1 

Caption = "Clear" 

Height = 1455 

Left = 3720 

Tablndex = 2 

Top = 2520 

Width = 1455 
End 

Begin VB.TextBox Textl 

Height = 855 

Left = 600 

Tablndex = 1 

Text = "Textl" 

Top = 960 

Width =2175 
End 

Begin VB.CommandButton cmdRun 
Caption = "Run" 
Height = 1335 
Left = 3720 

Tablndex = 0 
Top = 960 

Width = 1455 
End 
End 

Attribute VB_Name = "Forml" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed - False 
Option Explicit 



Private Sub cmdRun_Click() 

Dim udtP As New Prolog 
Dim IngR As Long 

If udtP.StartProlog("hlp4Iib.p4") = False Then 

Call MsgBox("Prolog failure on startup", vbExclamation, "Error") 
End If 

Call udtP.AddVariable("int(I),[520<=I<=590 step 5], int(I2),[I + 5<=I2<=I + 30 step 1]") 
IngR = udtP.SolveConstraintsOrdered(l) 
Textl = Str(lngR) 
End Sub 

Private Sub Command I ClickQ 

Textl = 
End Sub 
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' frmAbout.frm 
VERSION 5.00 
Begin VB.Form frm About 
BorderStyle = 4 'Fixed ToolWindow 
Caption = "About TCA" 
ClientHeight = 2610 
ClientLeft = 45 
ClientTop = 285 
ClientWidth = 4440 
LinkTopic = "Forml" 
LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 2610 
ScaleWidth = 4440 
ShowInTaskbar = 0 'False 
StartUpPosition = 1 'CenterOwner 
Begin VB.CommandButton cmdOK 

Caption = "OK" 

Height = 495 

Left = 3120 

Tablndex = 1 

Top = 120 

Width = 1215 
End 

Begin VB.Label IblVersion 

Height = 255 

Left = 240 

Tablndex = 2 

Top = 2160 

Width = 2295 
End 

Begin VB.Label Labell 

Caption = "TCA is a collaborative development of the Assessment and Research 
Divisions." 

Height = 615 

Left = 240 

Tablndex = 0 

Top = 1320 

Width = 2535 
End 

Begin VB. Image imaETS 
BorderStyle = 1 'Fixed Single 
Height = 780 
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Left = 960 
Picture = "frmAbout.fD{":0000 
Top = 240 

Width = 1275 
End 
End 

Attribute VB_Name = "frmAbout" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 

Private Sub cmdEasterEgg_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As 
Single) 

If Button = vbRightButton Then 

' display easter egg 

Beep 
End If 

End Sub 

Private Sub cmdOK_Click() 

Unload Me 
End Sub 

Private Sub Form_Load() 

IblVersion =^ frmSplash.lblVersion 
End Sub 

Private Sub imaETS_DblClick() 

' display easter egg 
Beep 

End Sub 



' fhnAttributes.frm 
VERSION 5.00 
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Begin VB.Form fimAttributes 
BorderStyle = 4 'Fixed ToolWindow 
Caption = "Family Attributes" 
ClientHeight = 1590 
ClientLeft = 45 
ClientTop =285 
ClientWidth = 4305 
LinkTopic = "Forml" 
LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 1590 
ScaleWidth = 4305 
ShowInTaskbar = 0 'False 
StartUpPosition = 1 'CenterOwner 
Begin VB.ComboBox cboProximity 
Height = 315 

ItemData = "frmAttributes.frx":0000 
Left = 240 

List = "fnnAttributes.fDc":OOOD 
Style = 2 'Dropdown List 
Tablndex = 4 
Top = 360 

Width = 1935 
End 

Begin VB.OptionButton optGeneric 



Caption 


= "Generic' 


Height 


= 195 


Index 


= 0 


Left 


= 120 


Tablndex 


= 3 


Top 


= 1035 


Value 


= -1 'True 


Width 


= 975 



End 

Begin VB.OptionButton optGeneric 



Caption 


= "Non 


Height 


= 195 


Index 


= 1 


Left 


= 1080 


Tablndex 


= 2 


Top 


= 1035 


Width 


= 1455 



End 

Begin VB.CommandButton cmdCancel 



Caption = "Cancel" 
Height = 495 
Left = 3000 
Tablndex = 1 

ToolTipText = "Click here to return without saving these family attributes." 
Top = 720 

Width = 1215 
End 

Begin VB.CommandButton cradOK 
Caption = "OK" 
Default = -1 'True 
Height = 495 
Left = 3000 
Tablndex = 0 
15 ToolTipText = "Click here to save these family attributes." 

Top = 120 

Width = 1215 
End 

Begin VB.Labellbl 
Caption = "Variant proximity" 
Height = 255 
Ji Left - 240 

J; Tablndex = 5 

5 Top = 120 

2i; Width = 1335 

m End 
= End 

0 Attribute VB_Name = "frm Attributes" 

Attribute VB_GlobalNameSpace = False 
3f f Attribute VB_Creatable = False 
=1 Attribute VBPredeclaredId = True 
5=3 Attribute VB JExposed = False 

Option Explicit 

Private mblnOK As Boolean 

35 Private mblnGeneric As Boolean 

Private mudtProximity As Proximity 

Private Sub Form_Load() 

mblnOK = False 

cboProximity.Listlndex = frmTCA.Family.Proximity 
40 IffrmTCA.Family.GenericThen 
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optGeneric(O) = Trae 
Else 

optGeneric(l) = True 
End If 

mblnGeneric = frmTCA.Family. Generic 
mudtProximity = frmTCA.Family .Proximity 

End Sub 

Public Property Get ProximityQ As Proximity 

Proximity = mudtProximity 
End Property 

Public Property Get GenericQ As Boolean 

Generic = mblnGeneric 
End Property 

Private Sub cmdOK_Click() 

mblnOK = True 

Unload Me 
End Sub 

Private Sub cmdCancel_Click() 

Unload Me 
End Sub 

Public Property Get OKQ As Boolean 

OK = mblnOK 
End Property 

Private Sub cboProximity_Click() 

mudtProximity = cboProximityXistlndex 



End Sub 

Private Sub optGeneric_Click(Index As Integer) 

mblnGeneric = optGeneric(O) 
End Sub 



' frmComments.frm 
VERSION 5.00 
Begin VB.Fonn frmComments 
BorderStyle = 4 'Fixed ToolWindow 
Caption "Comments" 
ClientHeight = 3765 
ClientLeft = 45 
ClientTop =285 
ClientWidth = 5250 
LinkTopic = "Forml" 
LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 3765 
ScaleWidth = 5250 
ShowInTaskbar = 0 'False 
StartUpPosition = 2 'CenterScreen 
Begin VB.CommandButton cmdCancel 

Caption = "Cancel" 

Height = 495 

Left = 3960 

Tablndex = 2 

ToolTipText = "Click here to save these family attributes. 
Top = 720 

Width = 1215 
End 

Begin VB.CommandButton cmdOK 
Caption = "OK" 
Default = -1 'True 
Height = 495 
Left = 3960 
Tablndex = 1 

ToolTipText = "Click here to save these family attributes. 
Top = 120 

Width = 1215 
End 

Begin VB.TextBox txtComment 

Height = 3495 

Left = 120 

MultiLine = -1 'True 

Tablndex = 0 

Top = 120 

Width = 3735 
End 
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End 

Attribute VB^^Name = 'TrmComments" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId ^ True 
Attribute VB_Exposed = False 
Private mstrComment As String 

Public Property Get Comment () As String 

Comment = mstrComment 

End Property 

Public Property Let Comment(ByVal strNewValue As String) 

txtComment strNewValue 
mstrComment = strNewValue 

End Property 

Private Sub cmdCancel_Click() 

Unload Me 
End Sub 

Private Sub cmdOK_Click() 

mstrComment = txtComment 
Unload Me 

End Sub 
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' frmDifficulty.frm 
VERSION 5.00 

Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.0CX" 
Begin VB.Form frniDifficulty 
BorderStyle - 4 'Fixed ToolWindow 
ClientHeight = 8730 
ClientLeft = 45 
ClientTop = 285 
ClientWidth = 6855 
LinkTopic = "Forml" 
LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 8730 
ScaleWidth = 6855 
ShowInTaskbar = 0 'False 
StartUpPosition = 2 'CenterScreen 
Begin VB.CheckBox chkRoute 

Caption = "Route to TCS" 

Height = 375 

Left = 2640 

Tablndex = 33 

Top = 1800 

Width = 1935 
End 

Begin VB.ComboBox cboKey 



Height 


= 315 


ItemData 


= "frmDifficulty.frx":0000 


Left 


= 2640 


List 


= "frmDifficulty.frx":0013 


Style 


= 2 'Dropdown List 


Tablndex 


= 30 


Top 


= 1200 


Width 


= 615 



End 

Begin VB.CheckBox chkCalcDifficulty 

Caption = "Calculate difficulty" 

Height = 255 

Left = 240 

Tablndex = 27 

Top = 3600 

Value = 1 'Checked 

Width = 1935 
End 
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Begin VB.ComboBox cboDeliveryMode 
Height = 315 

ItemData = "frmDifficulty.frx":0026 
Left = 2640 

List = "fnnDifficulty.frx":0030 

Style = 2 'Dropdown List 
Tablndex = 25 
Top = 480 

Width = 1695 
End 

Begin VB.ComboBox cboDomain 
Height = 315 

ItemData = "frmDifficulty.fo":003E 
Left = 240 

List = "frmDifficulty.frx":004E 

Style = 2 'Dropdown List 
Tablndex = 18 
Top = 1200 

Width = 1695 
End 

Begin VB.OptionButton optNature 

Caption = "Pure" 

Height = 375 

Index = 0 

Left = 240 

Tablndex = 17 

Top = 1800 

Value = -1 'True 

Width = 735 
End 

Begin VB.OptionButton optNature 

Caption = "Real" 

Height = 375 

Index = 1 

Left = 1200 

Tablndex = 16 

Top = 1800 

Width = 735 
End 

Begin VB.CommandButton cmdOK 
Caption = "OK" 
Default = -1 True 
Height = 495 
Left = 5520 

Tablndex = 8 
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10 



15 



20i 



40 



ToolTipText = "Click here to save changes and return." 
Top = 240 

Width = 1215 
End 

Begin VB.CommandButton cmdCancel 
Caption = "Cancel" 
Height = 495 
Left = 5520 
Tablndex = 7 

ToolTipText = "Click here to save changes and return." 
Top = 840 

Width = 1215 
End 

Begin VB.TextBox txtBatchId 

Height = 315 
Left = 240 
Tablndex = 0 
Top = 480 

Width = 1695 
End 

Begin ComctlLib. Slider sldTDEstimate 





Height 


375 




Left 


480 




Tablndex 


= 20 




Top = 


2760 




Width 


3975 




_ExtentX 


= 7011 




_ExtentY 


= 661 




_Version 


= 327682 




LargeChange 


= 1 




Min = 


1 




Max 


5 




SelStart 


1 




Value = 


1 


35 


End 





45 



Begin VB.Frame ft-aPredDiff 
Caption - "Predicted Difficulty" 
Height = 1575 
Left = 480 
Tablndex = 10 
Top = 6720 

Width = 4575 
Begin ComctlLib. Slider sldDiffEstimate 

Height = 375 

Left = 240 
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Tablndex = 11 

Top = 720 

Width = 3975 

_ExtentX = 7011 

5 _ExtentY = 661 

_Version = 327682 

Min = 1 

Max = 5 

SelStart = 1 

10 Value = 1 
End 

Begin VB .Label IbllRTValue 

Height = 255 

Left = 1080 

15 Tablndex = 32 

Top = 360 

Width = 3015 
End 

f 1 Begin VB.Label IblPredEasy 

2Qi Caption = "Easy" 

m Height = 255 

U1 Left = 3840 

4« Tablndex = 15 

€1 Top = 1200 

2^! Width = 615 
End 

1, Begin VB.Label IblPredMed 

Caption = "Medium" 

% Height = 255 

3i Left = 1920 

fi Tablndex = 14 

E Top = 1200 

Width = 855 
End 

35 Begin VB.Label IblPredDiff 

Caption - "Difficuh" 

Height =255 

Left = 240 

Tablndex = 13 

40 Top = 1200 

Width - 735 
End 

Begin VB.LabellblIRT 

Caption = "IRTb:" 

45 Height = 255 
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Left - 360 
Tablndex = 12 
Top = 360 

Width = 495 
End 
End 

Begin VB.Frame fraGREDiff 
Caption = "GRE Difficulty " 
Height = 4575 
Left = 240 

Tablndex = 2 
Top = 3960 

Width = 5055 
Begin VB.ComboBox cboGREConcept 



Height 


= 315 


ItemData 


= "frmDifficulty.frx":0080 


Left 


= 240 


List 


= "frmDifficulty.frx":0093 


Style 


= 2 'Dropdown List 


Tablndex 


= 28 


Top 


= 2160 


Width 


= 2055 



End 

Begin VB.ComboBox cboGRECog 
Height = 315 

ItemData = "fnnDifficulty.frx":OOED 
Left = 240 

List = "frmDifficulty.frx":OOFA 
Style = 2 'Dropdown List 
Tablndex = 5 
Top = 1440 

Width = 2055 
End 

Begin VB.ComboBox cboGREComp 



Height 


= 315 


ItemData 


= "&mDifficulty.fi:x":012D 


Left 


= 240 


List 


= "frmDifficulty.frx":013D 


Style 


= 2 'Dropdown List 


Tablndex 


= 3 


Top 


= 720 


Width 


= 2055 



End 

Begin VB.Label IblConcept 
Caption = "Concept:" 



Height = 255 
Left = 240 
Tablndex = 29 
Top = 1920 

5 Width = 975 

End 

Begin VB.Label IblGRECog 
Caption = "Cognition:" 
Height = 255 
10 Left = 240 

Tablndex = 6 
Top = 1200 

Width = 975 
End 

1 5 Begin VB.Label IblGREComp 

Caption = "Computation:" 
Height = 255 
Left = 240 
f'\ Tablndex = 4 

2S1 Top = 480 

ai Width = 975 

Ul End 
4:: End 

J;l Begin VB.Frame fraGMATDiff 
2^= Caption = "GMAT Difficulty" 

Height = 4575 
Left = 240 
^ Tablndex = 9 

% Top = 3960 

M. Width = 5055 

n End 

Begin VB.Frame fraOther 
Height = 4575 
Left = 240 

35 Tablndex - 34 

Top = 3960 

Width = 5055 
End 

Begin VB.Label IblKey 
40 Caption = "Key:" 

Height =255 

Left = 2640 

Tablndex = 31 

Top = 960 

45 Width = 975 
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10 



15 



2Qi 



25== 



3d: 



35 



40 



End 

Begin VB.Label IblTarget 

Caption = "Target template:" 

Height = 255 

Left = 2640 

Tablndex = 26 

Top = 240 

Width = 1815 
End 

Begin VB.Label IblSlideDirections 



= "Adjust the sHde to estimated variant difficulty:" 
= 255 
= 600 

= 24 
= 2400 
= 3615 



Caption 
Height 
Left 

Tablndex 
Top 
Width 
End 

Begin VB.Label IblTDDiff 



= "Difficult" 

= 255 
= 480 

= 23 
= 3240 

= 735 



45 



Caption 
Height 
Left 

Tablndex 
Top 
Width 
End 

Begin VB.Label IblTDMed 

Caption = "Medium" 

Height = 255 

Left = 2160 

Tablndex = 22 

Top = 3240 

Width = 855 

End 

Begin VB.Label IblTDEasy 

Caption = "Easy" 

Height = 255 

Left = 4080 

Tablndex = 21 

Top = 3240 

Width = 615 

End 

Begin VB.Label IblDomain 

Caption = "Domain:' 

Height - 255 

Left = 240 



VBSCA -68- 



3 



Tablndex = 19 
Top = 960 

Width = 975 
End 

5 Begin VB.Label LblBatch 

Caption = "Batch id:" 
Height = 255 
Left = 240 
Tablndex = 1 
10 Top = 240 

Width = 975 
End 
End 

Attribute VB_Name = "frmDifficulty" 
1 5 Attribute VB_GIobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
ri Option ExpHcit 



2^1 Dim mudtFamily As Family 

U1 Dim mudtClone As Clone 

I' Dim mudtDE As DifficultyEstimate 

J3 Dim mudtGreDE As GE?£DifficultyEstimate 

t; Dim mudtGmatDE As GMATDifficultyEstimate 

2|, Dim mblnFormLoad As Boolean 

S= Public Property Let Family(ByVal udtNewValue As Family) 

r;] Set mudtFamily = udtNewVahie 

End Property 

Public Property Let Clone(ByVal udtNewValue As Clone) 
30 Set mudtClone = udtNewValue 

End Property 

Private Sub Form LoadQ 

Set mudtDE = mudtClone.DiffEst 
35 mblnFormLoad = True 
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' if there's a key, prohibit input. 

If mudtFamily.ItemType = ptStandardMC Then 

cboKey.Enabled False 
Else 

cboKey.Enabled = True 
End If 

' change form depending on program 
Select Case mudtFamily.Program 
Case prGRE 

fraGREDiffZOrder 
fraPredDiff.ZOrder 
Case prGMAT 
fraGMATDiff.ZOrder 
fraPredDiffZOrder 
Case Else 

fraOther.ZOrder 
End Select 

cboDomain.Listlndex = mudtClone.Domain 
txtBatchId = mudt Clone. BatchID 
cboDeliveryMode.Listlndex ^ mudtClone.DeliveryMode 

' if key is not set, force "A" 
If mudtClone.key = Then 

cboKey = "A" 
Else 

cboKey = mudtClone.key 
End If 

If mudtClone.Nature = naPure Then 

optNature(O) = True 
Else 

optNature(l) True 
End If 

sldTDEstimate = mudtClone.TDEstimate 
chkRoute mudtClone.IsRouted 
chkCalcDifficulty = mudtClone JsDifficultyCalculated 
chkCalcDifficulty_Click ' update screen accordingly 
If mudtClone JsDifficultyCalculated Then 
Select Case mudtFamily.Program 
Case prGRE 

Set mudtGreDE = mudtClone.DiffEst 
cboGREComp.Listlndex = mudtGreDE.Computation 
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cboGRECog.Listlndex = mudtGreDE.Cognition 

cboGREConcept.Listlndex = mudtOreDE. Concept 

CreateDiffEst 
Case prGMAT 

Set mudtGmatDE = mudtClone.DiffEst 

' nothing to load 

CreateDiffEst 
Case prS AT 

' do nothing 
End Select 
Else 

cboGREComp.Listlndex = 0 
cboGRECog.Listlndex = 0 
cboGREConcept.Listlndex ^ 0 
End If 

mblnForaiLoad - False 
End Sub 

Private Sub cmdOK_Click() 

CreateProfile 

Unload Me 
End Sub 

Private Sub cmdCancel_Click() 

Unload Me 
End Sub 

Private Sub cboDomain_Click() 

CreateProfile 
End Sub 

Private Sub cboGRECog_Click() 

CreateProfile 
End Sub 
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Private Sub cboGREComp_Click() 

CreateProfile 
End Sub 

Private Sub cboGREConcept_Click() 

CreateProfile 
End Sub 

Private Sub cboKey_Click() 

CreateProfile 
End Sub 

Private Sub optNature_Click(Index As Integer) 

CreateProfile 
End Sub 

Private Sub sldTDEstimate ClickQ 

CreateProfile 
End Sub 

Private Sub chkCalcDifficulty_Click() 

fraPredDiff.Enabled = CBool(chkCalcDifficulty) 
fraGREDifif. Enabled = CBool(chkCalcDifficulty) 
fraGMATDiff Enabled = CBool(chkCalcDifficulty) 
IblGREComp.Enabled = CBool(chkCalcDifficulty) 
cboGREComp.Enabled = CBool(chkCalcDifficulty) 
IblGRECog.Enabled = CBool(chkCalcDifficulty) 
cboGRECog.Enabled = CBool(chkCalcDifficulty) 
IblConcept-Enabled = CBool(chkCalcDifficulty) 
cboGREConcept.Enabled = CBool(clikCalcDifficulty) 
IbllRT.Enabled = CBool(chkCalcDifficulty) 
IbllRTValue. Enabled = CBool(chkCalcDifficulty) 
IblPredDiffEnabled = CBool(chkCalcDifficulty) 
IblPredEasy.Enabled = CBool(chkCalcDifficulty) 
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lblPredMed.Enabled - CBool(chkCalcDifficulty) 
IblPredDiff.Enabled = CBool(chkCalcDifficulty) 

If chJcCalcDifficulty Then 

CreateProfile 
End If 

End Sub 

Private Sub CreateProfileQ 

' don't do it if were still loading form 
If mblnFormLoad Then Exit Sub 

mudtClone.Program = mudtFamily.Program 
mudtClone.Domain = cboDomain.Listlndex 
mudtClone.BatchID = txtBatchId 

mudtClone.DeliveryMode = cboDeHveryMode.Listlndex 
mudtClone.key ^ cboKey 
If optNature(O) = True Then 

mudtClone.Nature = naPure 
Else 

mudtClone.Nature = naReal 
End If 

mudtClone.IsRouted = chkRoute 
mudtClone.TDEstimate = sldTDEstimate 

mudtCloneJsDifficultyCalculated = chkCalcDifficulty 

If chkCalcDifficulty Then 

CreateDiffEst 
End If 

End Sub 

Private Sub CreateDiffEstQ 

If mudtClone.IsDifficultyCalculated Then 
Set mudtDE = Nothing 
Select Case mudtFaniiily.Program 
Case prGRE 

Set mudtGreDE = Nothing 
Set mudtGreDE = New GREDifficultyEstimate 
mudtGreDE.Domain = cboDomain.Listlndex 
mudtGreDE.Computation = cboGREComp.Listlndex 
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mudtGreDE.Cognition = cboGRECog.Listlndex 
mudtGreDE.Concept = cboGREConcept.Listlndex 
mudtGreDE.key = cboKey 
If optNature(O) = True Then 

mudtGreDE.Nature = naPure 
Else 

mudtGreDE.Nature = naReal 
End If 

mudtGreDE.ItemType = mudtFamily.ItemType 
' attach this GRE DE to the clone 
mudtClone.DiffEst = mudtGreDE 
Set mudtDE = mudtGreDE 
SetPredDiffSlider 
Case prGMAT 

Set mudtGmatDE = Nothing 

Set mudtGmatDE = New GMATDifficultyEstimate 

mudtGmatDE.Domain = cboDomain.Listlndex 

mudtGmatDE.key = cboKey 

If optNature(O) = True Then 

mudtGmatDE.Nature = naPure 
Else 

mudtGmatDE.Nature = naReal 
End If 

mudtGmatDE.ItemType = mudtFamily.ItemType 
mudtGmatDE.TDDifflEst = sldTDEstimate 
' attach this GMAT DE to the clone 
mudtClone.Difffist = mudtGmatDE 
Set mudtDE = mudtGmatDE 
SetPredDiffSlider 
Case prSAT 
' do nothing 
End Select 
Else ' opted not to calc difficulty 
mudtClone-DiffEst - Nothing 
End If 

End Sub 

Private Sub SetPredDiffSliderQ 
Dim dblIRT As Double 
dblIRT - mudtDE.ComputeDifficulty 
IbllRTValue = Format(dblIRT, "0.#") 
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Select Case mudtFamily.Program 
Case prGRE 

IfdblIRT< -1.001 Then 

sldDiffEstimate = 5 
Elself dblIRT < -0.238 Then 

SldDiffEstimate = 4 
ElseIfdblIRT< 0.379 Then 

sldDiffEstimate = 3 
ElseIfdblIRT< 0.931 Then 

sldDiffEstimate = 2 
Else 

sldDiffEstimate = 1 
End If 
Case prGMAT 
IfdblIRT< -0.919 Then 

sldDiffEstimate = 5 
Elself dblIRT < -0.093 Then 

sldDiffEstimate - 4 
Elself dblIRT < 0.565 Then 

sldDiffEstimate = 3 
ElseIfdblIRT< 1.197 Then 

sldDiffEstimate = 2 
Else 

sldDiffEstimate = 1 
End If 
End Select 



End Sub 



' frmDrag.frm 
VERSION 5.00 
Begin VB.Form frmDrag 
Caption = "Window drag control" 
ClientHeight = 1005 
ClientLeft = 60 
ClientTop = 345 
ClientWidth = 3060 
LinkTopic = "Forml" 
ScaleHeight = 1005 
ScaleWidth = 3060 
StartUpPosition = 2 'CenterScreen 
Begin VB.CommandButton Command2 

Caption = "Full Drag OFF" 

Height =735 

Left = 1560 

Tablndex = 1 

Top = 120 

Width = 1215 
End 

Begin VB.CommandButton Command 1 

Caption = "Full Drag ON" 

Height = 735 

Left = 120 

Tablndex = 0 

Top = 120 

Width = 1215 
End 
End 

Attribute VB_Name = "fimDrag" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 

Private Declare Function SystemParametersInfo Lib "user32" 
Alias "SystemParametersInfoA" (ByVal uAction As Long, 
ByVal uParam As Long, ByRef IpvParam As Any, _ 
ByVal fuWinIni As Long) As Long 

Private Const SPI_GETDRAGFULL WINDOWS = 38 
Private Const SPI_SETDRAGFULLWINDOWS = 37 
Private Const SPIF SENDWININICHANGE = 2 
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Public Function IsFullWindowDragOnQ As Boolean 
Dim result As Long 
'Call API and check for successful call. 

If SystemParametersInfo(SPI_GETDRAGFULL WINDOWS, 0&, result, 0&) <> 0 Then 
5 'Feature supported now check value of result. 

If result = 0 Then 

IsFullWindowDragOn = False 
Else 

IsFullWindowDragOn = True 
10 End If 

'Call failed, feature not supported. 
Else 

IsFullWindowDragOn = False 
End If 

1 5 End Function 

41 Private Sub TumOffFullWindowDragQ 

'It Dim result As Long 

result = SystemParametersInfo(SPI_^SETDRAGFULLWINDOWS, 0&, _ 
2e(:; ByVal vbNullString, SPIF_SENDWININICHANGE) 

■L End Sub 

Private Sub TumOnFullWindowDrag() 

:;: ; Dim result As Long 

result = SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 1 &, _ 
ByVal VbNullString, SPIF^SENDWININICHANGE) 

End Sub 

Private Sub Commandl_Click() 

TumOnFuUWindowDrag 
End Sub 

Private Sub Conimand2_Click() 
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TumOffFuUWindowDrag 
End Sub 



' fimlED.frm 
VERSION 5.00 
Begin VB.Form frmlED 
BorderStyle = 1 'Fixed Single 
Caption = "TCA Installation" 
ClientHeight = 1185 
ClientLeft = 45 
ClientTop =330 
ClientWidth = 2475 
LinkTopic = "Forml" 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 1185 
ScaleWidth = 2475 
StartUpPosition = 2 'CenterScreen 
Begin VB.CommandButton cmdOK 

Caption = "OK" 

Height = 375 

Left = 600 

Tablndex = 1 

Top = 720 

Width = 1215 
End 

Begin VB.Label Labell 

Caption = "Setting lED files to read-only." 

Height = 255 

Left = 240 

Tablndex - 0 

Top = 240 

Width = 2055 
End 
End 

Attribute VB_Name = "frmlED" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False * 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 

Private Sub cmdOK ClickQ 

Unload Me 

End Sub 
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Private Sub Form_Load() 

Call Shell("attrib +r C:\tcs\working\dscbt.ied", vbHide) 
Call ShellC'attrib +r C:\tcs\working\qccbt.ied", vbHide) 
Call ShellC'attrib +r C:\tcs\working\qcppt.ied", vbHide) 
Call ShellC'attrib +r C:\tcsWorking\ssmccbt.ied", vbHide) 
Call ShellC'attrib +r C:\tcs\working\ssmcppt.ied", vbHide) 

End Sub 
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' fhnlndexedString.frm 
VERSION 5.00 

Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.0CX" 
Begin VB.Form fhnlndexedString 
B orders tyle = 4 'Fixed Tool Window 
ClientHeight = 2265 
ClientLeft = 45 
ClientTop - 285 
ClientWidth = 5835 
LinkTopic = "Forml" 
LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 2265 
ScaleWidth = 5835 
ShowInTaskbar = 0 'False 
StartUpPosition = 1 'CenterOwner 
Begin ComctlLib.ListView Ivwindexed 

Height = 1815 

Left = 120 

Tablndex = 6 

Top = 120 

Width - 4215 

_ExtentX = 7435 

_ExtentY = 3201 

View = 3 

Arrange = 2 

LabelEdit = 1 

MultiSelect = -1 'True 

Label Wrap = -1 'True 

HideSelection = 0 'False 

_Version - 327682 

ForeColor = -2147483640 

BackColor = -2147483643 

BorderStyle = 1 

Appearance = 1 

Numltems = 2 

BeginProperty ColumnHeader(l) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 

Key = "" 

ObjectTag = "" 

Text = "Index" 

Object. Width = 529 
EndProperty 

BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
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Subltemlndex = 1 
Key = "" 

Object.Tag = "" 

Text = "Value" 
Object. Width = 6174 
EndProperty 
End 

Begin VB.CommandButton cmdAdd 
Caption = "Add" 
Height =255 
Left = 120 

Tablndex = 5 

ToolTipText = "Click here to add a value to the end of the list." 
Top = 1900 

Width = 975 
End 

Begin VB.CommandButton cmdinsert 
Caption = "Insert" 
Height = 255 
Left = 1080 
Tablndex = 4 

ToolTipText = "Click here to insert a value before the currently selected value." 
Top = 1900 

Width = 1095 
End 

Begin VB.CommandButton cmdEdit 
Caption = "Edit" 
Height = 255 
Left =2160 
Tablndex = 3 

ToolTipText = "Click here to edit the currently selected value." 
Top = 1900 

Width = 1095 
End 

Begin VB.CommandButton cmdRemove 
Caption = "Remove" 
Height = 255 
Left = 3240 

Tablndex = 2 

ToolTipText = "Click here to remove the selected value." 
Top = 1900 

Width = 1095 
End 

Begin VB.CommandButton cmdStrOK 
Caption = "OK" 
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Default = -1 'True 
Height = 495 
Left = 4440 

Tablndex = 0 

ToolTipText = "Click here to save changes and return." 
Top = 120 

Width = 1215 
End 

Begin VB.CommandButton cmdStrCancel 
Caption = "Cancel" 
Height = 495 
Left = 4440 

Tablndex = 1 

ToolTipText = "Click here to return without saving chang 
Top = 720 

Width = 1215 
End 

Begin VB.Menu mnulndexed 
Caption = "Indexed" 
Visible = 0 'False 
Begin VB.Menu mnuIndexedAdd 

Caption = "Add" 
End 

Begin VB.Menu mnulndexedlnsert 

Caption = "Insert" 
End 

Begin VB.Menu mnuIndexedEdit 

Caption = "Edit" 
End 

Begin VB.Menu mnuIndexedRemove 

Caption = "Remove" 
End 
End 
End 

Attribute VB_Name = "frmlndexedString" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 

Private mudtModel As Model 
Private mudtEF As EditFlags 
Private mstrVariableName As String 
Private mcolStrings As Collection 
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Private mblnOK As Boolean 

Public Property Let Model(ByVal udtNewValue As Model) 

Set mudtModel = udtNewValue 
End Property 

Public Property Let AddEditFlag(ByVal udtNewValue As EditFlags) 

mudtEF = udtNewValue 
End Property 

Public Property Let SubStringCollection(ByVal colNewValue As Collection) 
1 0 Set mcolStrings ^ colNewValue 

. End Property 
Q: Private Sub cmdAdd_Click() 
J] Call mnuIndexedAdd_Click 

m 

4" End Sub 

Private Sub cmdEdit_Click() 
~X Call mnuIndexedEdit_Click 

29^; End Sub 

Private Sub cmdInsert_Click() 

Call mnuIndexedInsert_Click 
End Sub 

25 Private Sub cmdRemove_Click() 
Call mnuIndexedRemove_Click 
End Sub 

Private Sub Form_Load() 
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Dim varS As Variant 
Dim IsiLI As Listltem 

Dim udtWAPI As New Win32API 

' enable full row select 

Call udtWAPLEnableListViewFullRowSelect(lvwIndexed) 
mblnOK = False 

frmlndexedString. Caption = "Editing substrings of string " & mstrVariableName 

If mudtEF = aeEdit Then 
With Ivwindexed 
For Each varS In mcolStrings 
Set IsiLI = .Listltems.Add 
UpdateListView 
IsiLLSubltems(l) - varS 
Next varS 
End With 
End If 

' prevent changes if model is frozen 
If mudtModel.IsFrozen Then 

cmdStrOK.Enabled = False 

cmdAdd.Enabled = False 

mnuIndexedAdd.Enabled == False 

cmdEdit.Caption = "Browse" 

mnuIndexedEdit.Caption = "Browse" 

cmdInsert.Enabled = False 

mnuIndexedlnsert.Enabled = False 

cmdRemove.Enabled False 

mnuIndexedRemove.Enabled = False 
End If 

End Sub 

Public Property Let VariableName(ByVal strNewValue As String) 

mstrVariableName = strNewValue 
End Property 

Public Property Get StringValueQ As String 
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Dim udtSS As New Substring 

udtSS.Delimiter = Chr(STRING_DELIMITER) 
udtSS.StringCoUection = mcolStrings 
StringValue = udtSS.StringValue 

End Property 

Public Property Get SubStringCoUectionQ As Collection 

Set SubStringCoUection ^ mcolStrings 
End Property 

Public Property Get 0K() As Boolean 

OK = mblnOK 
End Property 

Private Sub cmdStrOK_Click() 

Dim Isiltem As Listltem 

Set mcolStrings = New Collection 

For Each Isiltem In IvwIndexedXistltems 

Call mcolStrings.Add(lsiItem.SubItems(l)) 
Next isiltem 

mblnOK = True 

Unload Me 

End Sub 

Private Sub cmdStrCancel__Click() 

Unload Me 
End Sub 

Private Sub mnuIndexedAdd_Click() 
With frmString 
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' set the model 
.Model mudtModel 
' set the string 
.StringValue-"" 
' set var name 

.VariableName = mstrVariableName & "." _ 

& Trim(Str(lvwIndexed.ListItems.Count + 1)) 
'do it 

.Show vbModal 
If ,0K - False Then Exit Sub 
End With 

Dim IsiNewItem As Listltem 

Set IsiNewItem = IvwIndexedXistltems Add 
UpdateListView 

IsiNewItem. Subltems(l) ^ fimString.StringValue 
End Sub 

Private Sub mnuIndexedEdit__Click() 

With frmString 
' set the model 
.Model = mudtModel 
' set the string 

.StringValue = IvwIndexed.Selectedltem.Subltems(l) 
' set var name 

.VariableName = mstrVariableName & _ 

& Trim(Str(lvwIndexed,SelectedItem. Index)) 
'do it 

.Show vbModal 
If .OK - False Then Exit Sub 
End With 

IvwIndexed.Selectedltem.Subltems(l) = frmString, StringValue 
End Sub 

Private Sub mnuIndexedInsert_CUck() 

If IvwIndexed.Selectedltem Is Nothing Then Exit Sub 

With frmString 
' set the Model 
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.Model = mudtModel 
' set the string 
.StringValue - 
' set var name 

. VariableName = mstrVariableName 
'do it 

.Show vbModal 
If ,0K = False Then Exit Sub 
End With 

Dim IsiNewItem As Listltem 

Set IsiNewItem = lvwIndexed.ListItems.Add(lvwIndexed.SelectedItem .Index) 
UpdateListView 

IsiNewItem. Subltems(l) = frmString.StringValue 
End Sub 

Private Sub mnuIndexedRemove_Click() 

If IvwIndexed.Selectedltem Is Nothing Then Exit Sub 

Call IvwIndexed.Listltems.Remove(lvwIndexed.SelectedltemJndex) 
UpdateListView 

End Sub 

Private Sub UpdateListViewQ 
Dim inti As Integer 

For intI = 1 To IvwIndexed.Listltems. Count 

IvwIndexed.Listltems Jtem(intI).Text = Str(intl) 
Next intI 

End Sub 
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' fimNew.ftm 
VERSION 5.00 
Begin VB.Form frmNew 
BorderStyle = 4 'Fixed ToolWindow 
Caption = "New family properties" 
ClientHeight = 1740 
ClientLeft = 45 
ClientTop = 285 
ClientWidth = 6240 
LinkTopic = "Forml" 
LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 1740 
ScaleWidth = 6240 
ShowlnTaskbar = 0 'False 
StartUpPosition = 1 'CenterOwner 
Begin VB.CommandButton cmdCancel 

Cancel = -1 'True 

Caption = "Cancel" 

Height = 495 

Left = 4800 

Tablndex = 9 

Top = 720 

Width = 1215 
End 

Begin VB.CommandButton cmdOK 



Caption 


= "OK" 


Default 


= -1 'True 


Height 


= 495 


Left 


= 4800 


Tablndex 


= 8 


Top 


= 120 


Width 


= 1215 



End 

Begin VB.OptionButton optGeneric 

Caption = "Non-generic" 

Height = 195 

Index = 1 

Left = 3240 

Tablndex = 7 

Top = 1150 

Width = 1455 
End 



Begin VB.OptionButton optGeneric 







— (jrenenc 




Heignt 


— lyj 




Index 


— (J 


5 


Leit 


— zzoU 




Tablndex 


= 6 




Top 


= 1150 




Value 


= -1 True 




Width 


= 975 


10 


End 






Begin VB.ComboBox cboProximity 




Height 


= 315 




ItemData 


= "frmNew.frx":0000 




Left 


= 2280 


1 c 

15 


List 


= "frmNew.frx":000D 




Style 


= 2 'Dropdown List 




Tablndex 


= 4 




Top 


= 360 




Width 


= 1935 




End 






Begin VB.ComboBox cboItemType 




Height 


= 315 


4 ^ 


ItemData 


= "frmNew.frx":0024 




Left 


= 120 




List 


= "frmNew.frx":0031 




Style 


= 2 'Dropdown List 




Tablndex 


= 2 




Top 


= 1080 




Width 


= 1935 




End 






Begin VB.ComboBox cboProgram 




Height 


= 315 




ItemData 


= "fhnNew.frx":0072 




Left 


= 120 


35 


List 


= "frmNew.frx":007F 




Style 


= 2 'Dropdown List 




Tablndex 


= 0 




Top 


= 360 




Width 


= 1935 


40 


End 






Begin VB.Label Ibl 




Caption 


= "Variant proximity" 




Height 


= 255 




Left 


= 2280 


45 


Tablndex 


= 5 
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Top = 120 

Width - 1335 
End 

Begin VB. Label IblltemType 

Caption = "Item type" 

Height = 255 

Left - 120 

Tablndex = 3 

Top = 840 

Width = 1335 
End 

Begin VB. Label IblProgram 

Caption = "Program" 

Height = 255 

Left = 120 

Tablndex = 1 

Top - 120 

Width = 1335 
End 
End 

Attribute VB_Name = "frmNew" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable False 
Attribute VB__PredeclaredId ^ True 
Attribute VB_Exposed = False 
Option Explicit 

Private mblnOK As Boolean 

Private mudtProgram As Program 
Private mudtltemType As ItemType 
Private mudtProximity As Proximity 
Private mblnGeneric As Boolean 

Private Sub Fonn_Load() 

mblnOK = False 

' init combo boxes 
cboProgram.Listlndex = 0 
cboItemType.Listlndex = 0 
cboProximity.Listlndex = 0 



End Sub 



10 



Public Property Get 0K() As Boolean 

OK-mblnOK 
End Property 

Public Property Get Program() As Program 

Program = mudtProgram 
End Property 

Public Property Get ItemTypeQ As ItemType 

ItemType = mudtltemType 
End Property 
; Public Property Get Proximity() As Proximity 
gi Proximity = mudtProximity 

rff: End Property 

1 §^ Public Property Get GenericQ As Boolean 
Generic = mblnGeneric 
End Property 
f . Private Sub cboProgram_Click() 

mudtProgram = cboProgram.Listlndex 
20 End Sub 

Private Sub cboItemType_Click() 

mudtltemType = cboItemType.Listlndex 
End Sub 

Private Sub cboProximity__Click() 

mudtProximity = cboProximity.Listlndex 
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End Sub 

Private Sub optGeneric_Click(Index As Integer) 

mblnGeneric = optGeneric(O) 
End Sub 

Private Sub cmdOK_Click() 

mblnOK = True 

Unload Me 
End Sub 

Private Sub cmdCancel_Click() 

Unload Me 
End Sub 



' frmNewModel.fim 
VERSION 5.00 

Begin VB.Form frmNewFamily 
BorderStyle = 4 'Fixed ToolWindow 
Caption = "New family" 
ClientHeight = 1350 
ClientLeft = 45 
ClientTop = 285 
ClientWidth = 4680 
LinkTopic = "Forail" 
LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 1350 
ScaleWidth = 4680 
ShowInTaskbar = 0 'False 
StartUpPosition = 1 'CenterOwner 
Begin VB.OptionButton optModelType 

Caption = "Quantitative Comparision" 

Height =255 

Index = 1 

Left - 480 

Tablndex = 4 

Top = 480 

Width = 2535 
End 

Begin VB.OptionButton optModelType 

Caption = "Data Sufficiency" 

Height =255 

Index = 2 

Left = 480 

Tablndex = 3 

Top = 720 

Width = 2535 
End 

Begin VB.OptionButton optModelType 
Caption = "Standard Multiple Choice" 
Height = 255 
Index = 0 
Left = 480 

Tablndex = 2 
Top = 240 

Value = -1 'True 
Width = 2535 



End 

Begin VB.CommandButton cmdCancel 
Caption ^ "Cancel" 
Height = 495 
5 Left - 3360 

Tablndex = 1 

ToolTipText = "Click here to return without opening creating a new model." 

Top - 720 

Width = 1215 
10 End 

Begin VB.CommandButton cmdNewCreate 

Caption = "Create" 

Default = -1 True 

Height - 495 
15 Left = 3360 

Tablndex = 0 

ToolTipText = "Click here to create the new family." 
Top - 120 

n Width = 1215 

End 
End 

Attribute VB_Name = "frmNewFamily" 
Attribute VB_GlobalNameSpace ^ False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
L Option Explicit 

Private mblnOK As Boolean 

n ' holds the item type 
3t] Private mudtltemType As ItemType 

Pubhc Property Get 0K() As Boolean 

OK = mblnOK 

End Property 

35 Public Property Get ItemTypeQ As ItemType 
ItemType = mudtltemType 
End Property 
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Private Sub cmdNewCreate_Click() 

mblnOK = True 

Unload Me 
End Sub 

Private Sub cmdCancel_Click() 

mblnOK = False 

Unload Me 
End Sub 

Private Sub optModelType_Click(Index As Integer) 

mudtltemType = Index 
End Sub 
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' frmProgram.frm 
VERSION 5.00 
Begin VB.Form frmProgram 
Caption = "Select the program" 
ClientHeight = 1350 
ClientLeft = 60 
ClientTop = 345 
ClientWidth = 3225 
LinkTopic = "Forml" 
LockControls = -1 'True 
ScaleHeight = 1350 
ScaleWidth = 3225 
StartUpPosition = 1 'CenterOwner 
Begin VB.OptionButton optProgram 

Caption = "SAT" 

Height = 195 

Index = 2 

Left = 240 

Tablndex = 4 

Top = 720 

Width = 1335 
End 

Begin VB.OptionButton optProgram 

Caption = "GMAT" 

Height = 195 

Index = 1 

Left = 240 

Tablndex = 3 

Top = 480 

Width = 1335 
End 

Begin VB.OptionButton optProgram 



Caption 


= "ORE" 


Height 


= 195 


Index 


= 0 


Left 


= 240 


Tablndex 


= 2 


Top 


= 240 


Value 


= -1 'True 


Width 


= 1335 



End 

Begin VB.CommandButton cmdCancel 
Caption = "Cancel" 
Height = 495 



Left = 1920 

Tablndex = 1 

ToolTipText = "Click here to return." 
Top = 720 

Width - 1215 
End 

Begin VB.CommandButton cmdOK 
Caption - "OK" 
Height - 495 
Left - 1920 
Tablndex == 0 

ToolTipText = "Click here to save the currently selected program 
Top - 120 

Width - 1215 
End 
End 

Attribute VB_Name = "frmProgram" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 

Private mblnOK As Boolean 

Private mudtProgram As Program 

Public Property Get 0K() As Boolean 

0K = mbln0K 

End Property 

Public Property Get Program() As Program 

Program = mudtProgram 
End Property 

Private Sub cmdOK_Click() 
mblnOK = True 
Unload Me 
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End Sub 

Private Sub cmdCancel_Click() 

mblnOK = False 

Unload Me 
End Sub 

Private Sub optProgram_Click(Index As Integer) 

mudtProgram = Index 
End Sub 
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' fimProgress.frm 
VERSION 5.00 

Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.0CX" 
Begin VB.Form frmProgress 
BorderStyle = 1 'Fixed Single 
ClientHeight = 1110 
ClientLeft = 15 
ClientTop = 15 
ClientWidth = 4500 
ClipControls = 0 'False 
ControlBox = 0 'False 
LinkTopic = "Forml" 
LockControls = -1 'True 
MaxButton 0 'False 

MinButton = 0 'False 
ScaleHeight = 1110 
ScaleWidth = 4500 
StartUpPosition = 2 'CenterScreen 
Begin ComctlLib.ProgressBar prbProgressBar 

Height = 255 

Left = 240 

Tablndex = 0 

Top = 600 

Width = 3975 

_ExtentX = 7011 

_ExtentY = 450 

_Version = 327682 

Appearance = 1 

Max = 500 

End 

Begin VB.Label IblProgress 
Alignment = 2 'Center 
BeginProperty Font 

Name = "MS Sans Serif ' 

Size = 8.25 

Charset = 0 

Weight = 700 

Underline = 0 'False 

Italic - 0 'False 

Strikethrough = 0 'False 
EndProperty 
Height = 255 
Left = 240 
Tablndex = 1 
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Top = 240 

Width = 3855 
End 
End 

Attribute VB_Name = "frmProgress" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 



irmProlog.rrm 




\7irDCT/^AT c r\r\ 
VhKbiUJN J.UU 




Begin VB.Fonn 


fimProlog 


ooraeri^tyie 


— J L^izaoie 


ClientHeignt 


= 900 


ClientLeit 


= 2775 


Client lop 


= 37zO 


ClientWidth 


= 4440 


LinkTopic 


= "Forml" 


LockControls 


= -1 'True 


MaxButton 


= 0 'False 


MinButton 


= 0 'False 


ScaleHeight 


= 900 


ScaleWidth 


= 4440 



ShowInTaskbar = 0 'False 
StartUpPosition = 2 'CenterScreen 
Begin VB.CommandButton cmdAbort 



Caption 


■■ "Abort" 


Default 


-1 'True 


Height 


495 


Left 


3120 


Tablndex 


= 0 


Top = 


120 


Width 


1215 


End 




Begin VB.Label 


IblProlog 


Height 


495 


Left 


120 


Tablndex 


= 1 


Top = 


120 


Width 


2655 



End 
End 

Attribute VB_Name = "frmProlog" 
Attribute VB__GlobalNameSpace False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 

Option Explicit 

Private mblnAbort As Boolean 



Public Property Get AbortQ As Boolean 



Abort = mblnAbort 
End Property 
Public Sub KillO 

Unload Me 
End Sub 

Private Sub Form_Load() 

mblnAbort = False 
End Sub 

Private Sub cmdAbort_Click() 

mblnAbort = True 
Unload Me 

End Sub 



' frmSplash.frm 
VERSION 5.00 
Begin VB.Form fhnSplash 
BorderStyle = 3 'Fixed Dialog 
ClientHeight = 4245 
ClientLeft =255 
ClientTop = 1410 
ClientWidth = 7380 
ClipControls = 0 'False 
ControlBox = 0 'False 
Icon = "fnnSplash.frx":0000 
KeyPreview = -1 'True 
LinkTopic = "Form2" 
LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 4245 
ScaleWidth = 7380 
ShowInTaskbar = 0 'False 
StartUpPosition = 2 'CenterScreen 
Begin VB.Frame fraSplash 

Height = 4050 

Left = 120 

Tablndex = 0 

Top = 60 

Width = 7080 

Begin VB. Image imgLogo 
BorderStyle = 1 'Fixed Single 
Height = 780 
Left = 600 

Picture = "frmSplash.frx":OOOC 
Top - 720 

Width = 1275 
End 

Begin VB.Label IblCopyright 
Caption = "Copyright 1999" 
BeginProperty Font 

Name = "Arial" 

Size = 8.25 

Charset = 0 

Weight = 400 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 



EndProperty 
Height = 255 
Left = 4560 

Tablndex = 3 
5 Top = 3480 

Width = 2415 
End 

Begin VB.Label IblCompany 
Caption = "Educational Testing Service" 
10 BeginProperty Font 

Name = "Anal" 
Size = 8.25 
Charset = 0 
Weight = 400 
15 Underline = 0 'False 

Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
f - Height = 255 

25;; Left = 4560 

01 Tablndex = 2 

Oi Top = 3720 

i: Width = 2415 

f End 
2^;- Begin VB.Label IblWaming 

Caption = "Proprietary and Confidential" 
1. BeginProperty Font 

Name = "Arial" 
Size = 9.75 

3 ft! Charset = 0 

n Weight = 700 

i:;;: Underline = 0 'False 

Italic = 0 'False 
Strikethrough = 0 'False 
35 EndProperty 

Height = 315 
Left = 240 
Tablndex = 1 
Top = 3600 

40 Width = 2775 

End 

Begin VB.Label IblVersion 
AUgnment = 1 'Right Justify 
AutoSize = -1 'True 
45 Caption = "Version 1.25" 
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BeginProperty Font 
Name = "Arial" 
Size = 12 
Charset = 0 
5 Weight = 700 

Underline = 0 'False 
Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
10 Height = 285 

Left = 5265 
Tablndex = 4 
Top = 2880 

Width = 1410 
15 End 

Begin VB.Label IblProductName 
Auto Size = -1 'True 
Caption = "Assistant" 
BeginProperty Font 
M Name = "Arial" 

m Size = 48 

ill Charset = 0 

4: Weight = 700 

^ Underline = 0 'False 

2i= Italic = 0 'False 

? Strikethrough = 0 'False 

1, EndProperty 
i Height = 1125 

II Left = 1440 

3b: Tablndex = 6 

Top = 1560 

S=l Width = 4320 

End 

Begin VB.Label IblCompanyProduct 
35 AutoSize = -I 'True 

Caption = "Test Creation " 
BeginProperty Font 
Name = "Arial" 
Size = 18 
40 Charset = 0 

Weight = 700 
Underline = 0 'False 
Italic = 0 'False 
Strikethrough = 0 'False 
45 EndProperty 
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Height = 435 
Left = 2400 

Tablndex = 5 
Top = 1080 

Width - 2400 
End 
End 
End 

Attribute VB_Name = "frmSplash" 
Attribute VBGlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VBPredeclaredId = True 
Attribute VB_Exposed = False 

Option Explicit 

Public Sub UnloadMeO 

Unload Me 



End Sub 



' SetPrecision.frm 



VERSION 5.00 




Begin VB.Form frmSetPrecision 


Jborderatyie — 


4 rixcQ iooiwinaow 


Caption = 


"Set Precision" 


UlientrleigJit — 


1 Q^^ 


LlientJ^eit — 








ClientWidth = 


3540 


LinkTopic = 


"Fornil" 


MaxButton 


^ 0 'False 


MinButton 


0 'False 


ScaleHeight = 


1965 


ScaleWidth = 


3540 


ShowInTaskbar 


= 0 'False 


StartUpPosition = 


= 2 'CenterScreen 



Begin VB.CommandButton cmdSetPrecisionDefault 
Caption = "Default" 
Height = 495 
Left =2160 
Tablndex = 3 

ToolTipText = "Click here to return to the default value for precision." 
Top = 1320 

Width = 1215 
End 

Begin VB.CommandButton cmdSetPrecisionOK 
Caption = "OK" 
Default = -1 'True 
Height = 495 
Left = 2160 

Tablndex = 2 

ToolTipText - "Click here to save the displayed value." 
Top = 120 

Width = 1215 
End 

Begin VB.CommandButton cmdSetPrecisionCancel 
Caption = "Cancel" 
Height = 495 
Left = 2160 
Tablndex = 1 

ToolTipText = "Click here to return without saving any changes to precision." 
Top = 720 

Width = 1215 
End 
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Begin VB.TextBox txtPrecision 

Height - 315 

Left = 120 

Tablndex = 0 

Text = M" 

Top = 120 

Width = 1815 
End 
End 

Attribute VB_Name - "fhnSetPrecision" 
Attribute VB_GlobalNameSpace = False 
Attribute VB__Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option ExpUcit 

Private Sub cmdSetPrecisionCancel_Click() 

Unload Me 
End Sub 

Private Sub cmdSetPrecisionDefault_CHck() 

txtPrecision -",001" 
End Sub 

Private Sub cmdSetPrecisionOK_CUck() 

frmTCA.Precision = txtPrecision 
Unload Me 

End Sub 

Private Sub Form_Load() 

txtPrecision = frmTCA.Precision 
End Sub 

Private Sub txtPrecision_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtPrecision) 
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End Sub 
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' String.frm 
VERSION 5.00 
Begin VB.Form frmString 
BorderStyle = 4 'Fixed ToolWindow 
ClientHeight = 2265 
ClientLeft = 45 
ClientTop = 285 
ClientWidth = 5835 
LinkTopic "Forml" 
LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 2265 
ScaleWidth = 5835 
ShowInTaskbar = 0 'False 
StartUpPosition = 1 'CenterOwner 
Begin VB.CommandButton cmdStrOK 

Caption = "OK" 

Default = -1 'True 

Height = 495 

Left - 4440 

Tablndex = 1 

ToolTipText = "Click here to save changes and return." 
Top = 120 

Width = 1215 
End 

Begin VB.CommandButton cmdStrCancel 
Caption = "Cancel" 
Height = 495 
Left = 4440 

Tablndex = 2 

ToolTipText = "Click here to return without saving chang 
Top = 720 

Width = 1215 
End 

Begin VB.TextBox txtString 

Height = 315 

Left = 240 

Tablndex = 0 

Top = 480 

Width = 3975 
End 
End 

Attribute VB_Name = "frmString" 
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Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 

Private mudtModel As Model 
Private mstrVariableName As String 
Private mstrStringValue As String 
Private mblnOK As Boolean 

Public Property Let Model(ByVal udtNewValue As Model) 

Set mudtModel = udtNewValue 
End Property 

Public Property Let VariableName(ByVal strNewValue As String) 

mstrVariableName = strNewValue 
End Property 

Public Property Let StringValue(ByVal strNewValue As String) 

mstrStringValue = strNewValue 
End Property 

Public Property Get String ValueQ As String 

StringValue = mstrStringValue 
End Property 

Public Property Get 0K() As Boolean 

OK = mblnOK 
End Property 
Private Sub Form_Load() 

mblnOK = False 
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frmString. Caption = "Editing string " & mstrVariableName 

txtString = mstrStringValue 

If mudtModel.IsFrozen Then 
cmdStrOK.Enabled = False 
End If 

End Sub 

Private Sub cmdStrOK__Click() 

mblnOK = True 
StringValue = txtString 

Unload Me 

End Sub 

Private Sub cmdStrCancel_Click() 

Unload Me 
End Sub 

Private Sub txtString_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtString) 

End Sub 
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' TCA.FRM 
VERSION 5.00 

Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.0CX" 
Object = " {BDC2 1 7C8-ED 16-11 CD-956C-0000C04E4COA} #1 . 1 #0" ; "TABCTL32.0CX" 
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.0CX" 
Begin VB.Form frmTCA 
Caption = "ETS Test Creation Assistant" 
ClientHeight = 8310 
ClientLeft = 165 
ClientTop =735 
ClientWidth = 11400 
LinkTopic = "Forml" 
LockControls = -1 'True 
ScaleHeight = 8310 
ScaleWidth = 11400 
StartUpPosition = 3 'Windows Default 
Begin VB.Frame frmDummy 

Caption - "Common dialog anchor" 

Height = 855 

Left = 2640 

Tablndex = 3 

Top = 2280 

Visible = 0 'False 

Width = 2055 

Begin MSComDlg.CommonDialog cdlCD 
Left = 120 
Top = 240 

_ExtentX = 847 
_ExtentY = 847 
Version = 393216 
End 
End 

Begin VB.Frame fraWord 

Height = 8535 

Left = 120 

Tablndex = 1 

Top = 0 

Width = 6255 
End 

Begin TabDlg.SSTab sstMainTab 
Height = 8535 
Left = 6480 
Tablndex = 0 
Top = 0 
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Width = 5655 
_ExtentX = 9975 
_ExtentY = 15055 
_Version = 393216 
TabHeight - 520 

BeginProperty Font {0BE35203-8F91-1 1CE-9DE3-00AA004BB851} 

Name - "MS Sans Serif ' 

Size = 8.25 

Charset - 0 

Weight = 400 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 

TabCaption(O) = "Family Overview" 
TabPicture(O) = "TCA.frx":0000 



Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 



).Contro 
).Contro 
).Contro 
).Contro 
).Contro 
).Contro 
),Contro 
).Contro 
).Contro 
).Contro 
).Contro 
).Contro 
').Contro 
').Contro 
').Contro 
').Contro 
').Contro 
').Contro 
').Contro 
').Contro 
').Contro 
').Contro 
').Contro 
').Contro 
').Contro 
i).Contro 
).Contro 
i).Contro 
).Contro 



Enabled= -1 'True 
0)= "IblFamily" 

0) .Enabled= 0 'False 

1) = "imll" 

I) .Enabled= 0 'False 
;2)= "IblDummy" 
;2).Enabled= 0 'False 
3)= "IblAccepted" 

3) .Enabled= 0 'False 

4) = "IstAccepted" 
;4).Enabled= 0 'False 

5) = "txtVariablize" 

5) .Enabled= 0 'False 

6) = "treModels" 

6) .Enabled= 0 'False 

7) = "cmdSetAttributes" 

7) .Enabled= 0 'False 

8) = "IstDummy" 

8) .Enabled= 0 'False 

9) = "cmdDone" 
;9).Enabled= 0 'False 

10) = "cmdPrintBatch" 

10) .Enabled= 0 'False 

II) = "cmdTreeExtend" 

11) .Enabled= 0 'False 

12) = "cmdTreeRemove" 

12) .Enabled= 0 'False 

13) = "cmdAcceptedPaste" 
13).Enabled= 0 'False 
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10 



15 



2a; 



3g: 



35 



40 



Tab(0).Control(14)= "cmdAcceptedCopy" 
Tab(0).Control(14).Enabled= 0 'False 
Tab(0).Control(15)- "cmdAcceptedEdit" 
Tab(0).Control(15).Enabled= 0 'False 
Tab(0).ControlCount= 16 
TabCaption(l) = "Model Workshop" 



TabP 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 
Tab( 



cture(l) = "TCA.frx":001C 
).ControlEnabled= 0 'False 



).Control(0)= "Ibl Variables" 
).Control(l)= "IblCloningConstraints" 
).Control(2)= "IblDistractor" 
).Control(3)= "cmdExportConstraints" 
).Control(4)= "cmdImportConstraints" 
).Control(5)= "cmdSaveModel" 
).Control(6)= "crndTestAll" 
).Control(7)= "IstConstraints(l)" 
).Control(8)= "cmdVariableAdd" 
).Control(9)= "cmdVariableEdit" 
).Control(10)= "cmdVariableRemove" 
).Control(l 1)= "cmdVariableTest" 
).Control(12)= "cmdConstraintAdd(O)" 
).Control(13)= "cmdConstraintEdit(O)" 
).Control(l 4)= "cmdConstraintRemove(O)" 
).Control(l 5)= "cmdConstraintTest(O)" 
).Control(16)= "cmdConstraintAdd(l)" 
).Control( 1 7)= "cmdConstraintEdit( 1 )" 
).Control(18)= "cmdConstraintRemove(l)" 
).Control(19)- "cmdConstraintTest(l)" 
).Coiitrol(20)= "cmdPrintConstraints" 
).Control(21)= "IstConstraints(O)" 
).Control(22)= "IstVariables" 
).Control(23)= "cmdComments" 
l).ControlCount= 24 
TabCaption(2) = "Generate Variants" 
TabPicture(2) = "TCA.frx":0038 
Tab(2).ControlEnabled= 0 'False 



45 



Tab(2).Control(a 
Tab(2).Control(l 
Tab(2).Control(2 
Tab(2).Control(3 
Tab(2).Control(4: 
Tab(2).Control(5 
Tab(2).Control(6 
Tab(2).Control(7 
Tab(2).Control(8 



"cmdDispMakeModel" 

"cmdDispDiscard" 

"cmdDispDefer" 

"cmdDispAccept" 

"sldDifference" 

"IstDisposition" 

"cmdPrintVariants" 

"crndDisplayModel" 

"txtNum2 Generate" 
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Tab(2).Control(9)= "cmdGenerate" 
Tab(2).Control(10)= "IblDiff 
Tab(2).Control(ll)= "Labell" 
Tab(2).Control(12)= "IblMed" 
Tab(2).Control(13)= "IblLow" 
Tab(2).Control(14)= "IblVariants" 
Tab(2).Control( 1 5)= "LblNumVariants" 
Tab(2).ControlCoimt= 16 
Begin VB.CommandButton cmdComments 
Caption = "Comments" 
Height = 495 
Left - -70680 
Tablndex = 58 

ToolTipText = "Click here to print all variables and constraints." 
15 Top = 3720 

Width = 1215 
End 

Begin VB.ListBox IstVariables 
Draglcon = "TCA.frx":0054 
2S; Height = 1635 

ItemData = "TCA.fi:x":035E 
l2\ Left = -74760 

4; List - "TCA.frx":0360 

J,: Style = 1 'Checkbox 

2l" Tablndex = 57 

ToolTipText = "Left button click to select a constraint. Then right button click for 
^, constraint options." 

Top = 720 

!:! Width = 3855 

3|;' End 
r = Begin VB.ListBox IstConstraints 

n Draglcon = "TCA.frx":0362 

Height = 1635 
Index = 0 
35 ItemData = "TCA.frx":066C 

Left = -74760 

List = "TCA.frx":066E 
Style = 1 'Checkbox 
Tablndex = 56 

40 ToolTipText = "Left button click to select a constraint. Then right button click for 

constraint options." 

Top = 3120 

Width = 3855 
End 

45 Begin VB.CommandButton cmdAcceptedEdit 
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Caption 

Height 

Left 

Tablndex 

ToolTipText 

Top 



= "Edit Profile" 



■■ 255 
240 
= 54 



= "Click here to edit the profile of the selected variant. 



7300 



Width = 1335 
End 

Begin VB.CommandButton cmdAcceptedCopy 
Caption = "Copy Profile" 
Height = 255 
Left = 1560 
Tablndex = 53 

ToolTipText = "Chck here to copy the profile of the selected variant." 
Top = 7300 

Width = 1335 
End 

Begin VB.CommandButton cmdAcceptedPaste 
Caption = "Paste Profile" 
Height = 255 
Left = 2880 

Tablndex = 52 

ToolTipText = "Click here to paste a profile onto the currently selected variants." 
Top = 7300 

Width = 1215 
End 

Begin VB.CommandButton cmdPrintConstraints 
Caption = "Print Constraints" 
Height = 495 
Left = -70680 
Tablndex = 51 

ToolTipText = "Click here to print all variables and constraints." 
Top = 3120 

Width = 1215 
End 

Begin VB.CommandButton cmdDispMakeModel 
Caption = "Create Mdl." 
Height = 255 
Left = -71880 
Tablndex = 50 

ToolTipText = "Click here to create new children of the active model using the 
irrently selected variants." 
Top = 6120 

Width = 975 
End 
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Begin VB.CommandButton cmdDispDiscard 

Caption = "Discard" 

Height = 255 

Left = -72840 

5 Tablndex = 49 

ToolTipText = "Click here to discard the currently selected variants." 

Top = 6120 

Width = 975 
End 

1 0 Begin VB.CommandButton cmdDispDefer 

Caption = "Defer" 
Height = 255 
Left = -73800 

Tablndex = 48 

15 ToolTipText = "Click here to defer the currently selected variants." 

Top = 6120 

Width = 975 
End 

Begin VB.CommandButton cmdDispAccept 
2fl: Caption = "Accept" 

m Height = 255 

y: Left = -74760 

:j; Tablndex = 47 

ToolTipText = "Click here to accept the currently selected variants." 
2S3: Top = 6120 

J= Width = 975 

L., End 

Begin VB.CommandButton cmdTreeRemove 
Caption = "Remove" 
3^: Height = 255 

fj Left =2160 

r: Tablndex = 46 

ToolTipText = "Click here to remove a model." 
Top = 3720 

35 Width = 1935 

End 

Begin VB.CommandButton cmdTreeExtend 
Caption = "Extend" 
Height = 255 
40 Left = 240 

Tablndex = 45 

ToolTipText = "Click here to create a new child of the selected model." 
Top = 3720 

Width = 1935 
45 End 
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Begin VB.CommandButton cmdConstraintTest 
Caption = "Test" 
Height = 255 
Index = 1 
Left = -71880 
Tablndex = 44 

ToolTipText = "Click here to test all enabled variables and distractor constraints." 
Top = 7200 

Width = 975 
End 

Begin VB.CommandButton cmdConstraintRemove 
Caption = "Remove" 
Height = 255 
Index = 1 
Left = -72840 

Tablndex = 43 

ToolTipText = "Chck here to remove a distractor constraint." 
Top = 7200 

Width = 975 
End 

Begin VB.CommandButton cmdConstraintEdit 
Caption = "Edit" 
Height =255 
Index = 1 
Left = -73800 

Tablndex = 42 

ToolTipText = "Click here to edit the currently selected distractor constraint." 
Top = 7200 

Width = 975 
End 

Begin VB.CommandButton cmdConstraintAdd 
Caption = "Add" 
Height = 255 
Index = 1 
Left = -74760 
Tablndex = 41 

ToolTipText = "Click here to add a distractor constraint." 
Top = 7200 

Width = 975 
End 

Begin VB.CommandButton cmdConstraintTest 
Caption = "Test" 
Height = 255 
Index = 0 
Left = -71880 
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Tablndex = 40 

ToolTipText = "Click here to test all enabled variables and variation constraints." 
Top = 4800 

Width = 975 
5 End 

Begin VB.CommandButton cmdConstraintRemove 
Caption = "Remove" 
Height = 255 
Index = 0 
10 Left = -72840 

Tablndex = 39 

ToolTipText = "Chck here to remove the currently selected variation constraint." 

Top = 4800 

Width = 975 
15 End 

Begin VB.CommandButton cmdConstraintEdit 

Caption = "Edit" 

Height = 255 

Index - 0 
2(l{ Left = -73800 

|! Tablndex =38 

yi ToolTipText = "Click here to edit the currently selected variation constraint." 

if Top = 4800 

h Width = 975 

25|= End 

'Ji Begin VB.CommandButton cmdConstraintAdd 

Caption = "Add" 

Cj Height = 255 

If Index = 0 

3(rJ Left = -74760 

J=, Tablndex = 37 

Pi ToolTipText = "Click here to add a variation constraint." 

Top = 4800 

Width = 975 
35 End 

Begin VB.CommandButton cmdVariableTest 
Caption = "Test" 
Height = 255 
Left = -71880 
40 Tablndex = 36 

ToolTipText = "CUck here to test all enabled variables." 
Top = 2400 

Width = 975 
End 

45 Begin VB.CommandButton cmdVariableRemove 
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Caption = "Remove" 
Height = 255 
Left = -72840 
Tablndex = 35 

5 ToolTipText = "Click here to remove the currently selected variable." 

Top = 2400 

Width = 975 
End 

Begin VB.CommandButton cmdVariableEdit 
10 Caption = "Edit" 

Height = 255 
Left = -73800 
Tablndex = 34 

ToolTipText = "Click here to edit the currently selected variable." 
15 Top = 2400 

Width = 975 
End 

Begin VB.CommandButton cmdVariableAdd 
Caption = "Add" 
2(1= Height = 255 

Left = -74760 
=J1 Tablndex = 33 

i;: ToolTipText = "Chck here to add a variable." 

42 Top = 2400 

251" Width = 975 

J'^ End 

=. Begin VB.CommandButton cmdPrintBatch 

Caption = "Print All" 
% Height - 495 

3^:; Left = 4320 

f---: Tablndex = 31 

ToolTipText = "Chck here to print all variants." 
Top = 4200 

Width = 1215 
35 End 

Begin VB.CommandButton cmdDone 
Caption = "Done" 
Height = 495 
Left = 4320 
40 Tablndex = 29 

ToolTipText = "Click here when you are done with this family and are ready to send it 
back to TCS." 

Top = 1320 

Width = 1215 
45 End 
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Begin ComctlLib. Slider sIdDifference 

Height = 255 

Left = -73440 

Tablndex = 24 
5 ToolTipText = "Select the degree of randomization desired." 

Top = 1140 

Width = 1935 

_ExtentX = 3413 

_ExtentY = 450 
10 _Version = 327682 

Max = 2 

SelStart = 2 

Value = 2 
End 

1 5 Begin VB.ListBox IstDisposition 

Height = 3570 

ItemData = "TCA.frx":0670 

Left = -74760 

List = "TCA.fi^":0672 
2^, MultiSelect = 2 'Extended 

m Tablndex = 21 

;li ToolTipText = "Left button click to select a variant. Then right button click for variant 

j;; options." 

h Top = 2520 

2^= Width = 3855 

End 

= Begin VB.CommandButton cmdPrintVariants 

Gf Caption = "Print All" 

Height = 495 
3^ Left = -70680 

Tablndex = 20 

ToolTipText = "Click here to print all variants." 

Top = 2400 

Width = 1215 
35 End 

Begin VB.CommandButton cmdDisplayModel 

Caption = "Display Model" 

Height = 495 

Left = -70680 
40 Tablndex = 19 

ToolTipText = "Click here to view the active model." 

Top = 1320 

Width = 1215 
End 

45 Begin VB.ListBox IstDummy 
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Height 


= 255 


ItemData 


= "TCA.frx":0674 


Left 


= 4680 


List 


= "TCA.frx":0676 


Slorterl 


= -1 Tnie 


Tablndex 


= 18 


Top 


= 7800 


Visible 


= 0 'False 


Width 


= 615 



End 

Begin VB.TextBox txtNum2Generate 

Height =315 

Left = -74760 

Tablndex = 16 
1 5 TooITipText = "Enter the number variants to generate here." 

Top = 1140 

Width = 855 
End 

Begin VB.CommandButton cmdSetAttributes 
2^ Caption = "Set Attributes" 

m Enabled = 0 'False 

Ol Height = 495 

£ Left = 4320 

J] Tablndex 15 

2i" TooITipText = "Click here to reset the attributes for this model family." 

Top = 720 

!..., Width = 1215 

S End 

r: Begin ComctlLib.TreeView treModels 

3^: Draglcon = "TCA.frx":0678 

Height - 2955 
B Left = 240 

Tablndex = 13 

TooITipText = "Left button click on a model to select it. Then right button click for 
35 options." 

Top = 780 

Width = 3855 
_ExtentX = 6800 
_ExtentY = 5212 
40 _Version = 327682 

LabelEdit = 1 
LineStyle = 1 
Style = 7 
Appearance = 1 
End 
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Begin VB.ListBox IstConstraints 
Draglcon = "TCA.frx":07C2 
Height = 1635 
Index = 1 
5 ItemData = "TCA.fix":OACC 

Left = -74760 

List = "TCA.frx":OACE 
Style = 1 'Checkbox 
Tablndex = 10 

10 ToolTipText = "Left button click to select a constraint. Then right button click for 

constraint options." 

Top = 5520 

Width = 3855 
End 

1 5 Begin VB.ComraandButton cmdTestAll 

Caption = "Test AH" 
Height = 495 
Left = -70680 
r-: Tablndex = 8 

20-; ToolTipText = "CUck here to test all checked variables and constraints." 

Top = 1320 

U'^ Width = 1215 

4:: End 

4^1 Begin VB.ComraandButton cmdSaveModel 

Caption = "Save Model" 
Height = 495 
Left = -70680 

Tablndex = 7 

ToolTipText = "Click here to save this model." 
Top = 720 

Width = 1215 
E End 

Begin VB.CommandButton cmdImportConstraints 
Caption = "Import Constraints" 
35 Height = 495 

Left = -70680 
Tablndex = 6 

ToolTipText = "Click here to import a variable/constraint set." 
Top = 1920 

40 Width = 1215 

End 

Begin VB.CommandButton cmdExportConstraints 
Caption = "Export Constraints" 
Height = 495 
45 Left = -70680 
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Tablndex = 5 

ToolTipText = "Click here to export a variable/constraint set." 

Top = 2520 

Width = 1215 
5 End 

Begin VB.CommandButton cmdGenerate 

Caption = "Generate" 

Height = 495 

Left = -70680 
10 Tablndex = 4 

ToolTipText = "Click here to generate variants." 

Top = 720 

Width = 1215 
End 

Begin VB.TextBox txtVariabHze 



BackColor 


= &H8000000C& 


Height 


= 375 


Left 


= 5880 


Tablndex 


= 2 


Text 


= "Rob" 


Top 


= 4740 


Visible 


= 0 'False 


Width 


= 615 



20' 



m End 
2|- Begin VB.ListBox IstAccepted 

J) Height = 2985 

i ItemData = "TCA.fi^":OADO 

Left = 240 

List = "TCA.frx":0AD2 
3b:' MultiSelect = 2 'Extended 

Tablndex = 55 

f ToolTipText = "Left button cUck on a variant to view it. Then right button click for 

options." 

Top = 4320 

35 Width = 3855 

End 

Begin VB.Label IblAccepted 

Caption = "Accepted variants" 

Height = 255 
40 Left = 240 

Tablndex = 32 

Top = 4080 

Width = 2535 
End 

45 Begin VB.Label IblDiff 
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Caption = "Prolog randomization:" 

Height = 255 

Left = -73440 

Tablndex = 28 

5 Top = 840 

Width = 1935 
End 

Begin VB. Label Label! 

Caption = "High" 

10 Height = 255 

Left = -71760 

Tablndex = 27 

Top = 1440 

Width = 495 
15 End 

Begin VB. Label IblMed 

Caption = "Medium" 

Height = 255 

Left = -72720 

iM Tablndex = 26 

m Top = 1440 

m Width = 735 
];;: End 

Begin VB. Label IblLow 

2i;; Caption = "Low" 

€l Height = 255 

Left = -73440 

O Tablndex = 25 

J J Top = 1440 

3P Width = 495 
P; End 

p:- Begin VB .Label IblDummy 

BorderStyle = 1 'Fixed Single 

Height = 375 

35 Left = 4680 

Tablndex = 23 

Top = 6840 

Visible = 0 Talse 

Width = 615 
40 End 

Begin VB. Label IblVariants 

Caption = "Variants" 

Height = 255 

Left = -74760 

45 Tablndex = 22 



VBSCA -127- 



Top = 2280 

Width = 2055 
End 

Begin ComctlLib.ImageList imll 
Left = 4680 
Top = 7200 

_ExtentX = 1005 
_ExtentY = 1005 
BackColor = -2147483643 
ImageWidth = 16 
ImageHeight = 16 
MaskColor = 12632256 
_Version = 327682 

BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
NumListlmages = 2 

BeginProperty Listlmagel {0713E8C3-850A-101B-AFC0-4210102A8DA7} 

Picture = "TCA.frx":0AD4 

Key = "" 

EndProperty 

BeginProperty Listlmage2 {0713E8C3-850A-1O1B-AFC0-42101O2A8DA7} 
Picture = "TCA.frx":1026 
Key = "" 

EndProperty 
EndProperty 
End 

Begin VB .Label Lb INum Variants 

Caption = "Number:" 

Height = 255 

Left = -74760 

Tablndex = 17 

Top = 900 

Width = 735 
End 

Begin VB. Label IblFamily 

Caption = "Family members" 

Height = 255 

Left = 240 

Tablndex = 14 

Top = 540 

Width = 3615 
End 

Begin VB. Label IblDistractor 
Caption = "Distractor Constraints" 
Height = 255 
Left = -74760 
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10 



15 



2a\ 



30=: 



35 



40 



Tablndex = 12 
Top = 5280 

Width = 2535 
End 

Begin VB. Label IblCloningConstraints 



Caption 


= "Variation Constraints" 


Draglcon 


= "TCA.frx":1578 


Height 


= 255 


Left 


= -74760 


Tablndex 


= 11 


Top 


= 2880 


Width 


= 2535 



End 

Begin VB. Label IblVariables 



Caption 
Height 
Left 

Tablndex 
Top 
Width 
End 
End 

Begin ComctlLib.StatusBar stbS 



= "Variables" 

= 255 
= -74760 

= 9 
= 480 

= 855 



= 2 'Align Bottom 
= 300 
= 0 

= 30 
= 8010 
= 11400 

= 20108 

= 529 



45 



Align 
Height 
Left 

Tablndex 
Top 
Width 
_ExtentX 
_ExtentY 
SimpleText = "" 
_Version = 327682 

BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} 
NumPanels = 11 

BeginProperty Panell {0713E89F-850A-101B-AFC0-4210102A8DA7} 
Alignment = 2 
AutoSize = 2 
Bevel = 0 
Object. Width =2117 
MinWidth - 2117 
Text = "Program:" 

TextSave = "Program:" 
Key = "" 

Object.Tag = "" 
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EndProperty 

BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7} 

Alignment = 1 

AutoSize = 2 

Object.Width = 1058 

MinWidth = 1058 

Key = "" 

Object.Tag = "" 

EndProperty 

BeginProperty Panels {0713E89F-850A-101B-AFC0-4210102A8DA7} 

Alignment = 2 

AutoSize = 2 

Bevel = 0 

Object.Width = 1773 

MinWidth = 1764 

Text = "Family:" 

TextSave = "Family:" 

Key = "" 

Object.Tag = 
EndProperty 

BeginProperty Panel4 {0713E89F-850A-101B-AFC0-4210102A8DA7} 

Alignment = 1 

AutoSize = 2 

Object. Width = 2646 

MinWidth = 2646 

Key = "" 

Object.Tag = "" 

EndProperty 

BeginProperty Panel5 {0713E89F-850A-101B-AFC0-4210102A8DA7} 

Alignment = 2 

AutoSize = 2 

Bevel = 0 

Object.Width = 2117 

MinWidth = 2117 

Text = "Attributes:" 

TextSave - "Attributes:" 

Key = "" 

Object.Tag = "" 

EndProperty 

BeginProperty Panel6 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
Alignment = 1 
AutoSize = 2 
Object.Width = 1058 
MinWidth = 1058 
Key = "" 
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Object.Tag = 
EndProperty 

BeginProperty Panel? {0713E89F-850A-101B-AFC0-4210102A8DA7} 

Alignment = 1 

AutoSize = 2 

Object.Width = 1058 

MinWidth = 1058 

Key = "" 

Object.Tag = "" 

EndProperty 

BeginProperty Panel8 {0713E89F-850A-101B-AFC0-4210102A8DA7} 

AutoSize = 2 

Object.Width = 1058 

MinWidth = 1058 

Key = 

Object.Tag = 
EndProperty 

BeginProperty Panel9 {0713E89F-850A-101B-AFC0-4210102A8DA7} 

Alignment = 2 

AutoSize = 2 

Bevel = 0 

Object.Width = 2487 

MinWidth = 2469 

Text = "Active Model:" 

TextSave = "Active Model:" 

Key = "" 

Object.Tag = "" 

EndProperty 

BeginProperty PanellO {0713E89F-850A-101B-AFC0-4210102A8DA7} 

Alignment = 1 

AutoSize = 2 

Object. Width = 450 

MinWidth = 441 

Key = "" 

Object.Tag = "" 

EndProperty 

BeginProperty Panelll {0713E89F-850A-101B-AFC0-4210102A8DA7} 

Alignment = 1 

AutoSize = 2 

Object.Width = 2646 

MinWidth = 2646 

Key = "" 

Object.Tag = "" 

EndProperty 
EndProperty 
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End 

Begin VB.Menu ninuFile 
Caption = "File" 
Begin VB.Menu mnuFileNew 

Caption = "New" 
End 

Begin VB.Menu mnuFileOpen 

Caption = "Open" 
End 

Begin VB.Menu mnuFilelmportltem 

Caption = "Import Locked Item" 
End 

Begin VB.Menu mnuFileSaveAs 

Caption = "Save As" 

Visible = 0 'False 
End 

Begin VB.Menu mnuFileSave 

Caption = "Save" 

Visible = 0 'False 
End 

Begin VB.Menu mnuFilePrintSetup 

Caption = "Print Setup" 
End 

Begin VB.Menu mnuFileExit 

Caption = "Exit" 
End 
End 

Begin VB.Menu mnuHelp 

Caption = "Help" 

NegotiatePosition= 3 'Right 

Begin VB.Menu mnuHelp About 
Caption = "About" 

End 
End 

Begin VB.Menu mnuVariables 
Caption = "Variables" 
Visible = 0 'False 
Begin VB.Menu mnuVariablesAdd 

Caption = "Add" 
End 

Begin VB.Menu mnuVariablesEdit 

Caption = "Edit" 
End 

Begin VB.Menu mnuVariablesRemove 
Caption = "Remove" 



End 

Begin VB.Menu mnuVariablesRemoveAll 

Caption = "Remove All" 
End 

Begin VB.Menu mnuVariablesEnableAU 

Caption = "Enable All" 
End 

Begin VB.Menu mnuVariablesDisableAll 

Caption = "Disable All" 
End 

Begin VB.Menu mnuVariablesTest 

Caption = "Test" 
End 
End 

Begin VB.Menu mnuConstraints 
Caption = "Constraints" 
Visible = 0 'False 
Begin VB.Menu mnuConstraintsAdd 

Caption = "Add" 
End 

Begin VB.Menu mnuConstraintsEdit 

Caption = "Edit" 
End 

Begin VB.Menu mnuConstraintsRemove 

Caption = "Remove" 
End 

Begin VB.Menu mnuConstraintsRemoveAU 

Caption = "Remove AH" 
End 

Begin VB.Menu mnuConstraintsEnableAll 

Caption = "Enable All" 
End 

Begin VB.Menu mnuConstraintsDisableAU 

Caption = "Disable AH" 
End 

Begin VB.Menu mnuConstraintsTest 

Caption = "Test" 
End 
End 

Begin VB.Menu mnuDisp 
Caption = "Disposition" 
Visible = 0 'False 
Begin VB.Menu mnuDisp Accept 

Caption = "Accept" 
End 



Begin VB.Menu mnuDispDefer 

Caption = "Defer" 
End 

Begin VB.Menu mnuDispDiscard 

Caption = "Discard" 
End 

Begin VB.Menu mnuDispMakeModel 

Caption = "Create Model" 
End 
End 

Begin VB.Menu mnuTree 
Caption = "Tree" 
Visible = 0 'False 
Begin VB.Menu mnuTreeExtend 

Caption = "Extend" 

Enabled = 0 'False 
End 

Begin VB.Menu mnuTreeRemove 

Caption = "Remove" 
End 
End 

Begin VB.Menu mnuAccepted 
Caption = "Accepted" 
Visible = 0 'False 
Begin VB.Menu mnuAcceptedProfile 

Caption = "Edit profile" 
End 

Begin VB.Menu mnuAcceptedCopy 
Caption = "Copy profile" 
Enabled = 0 'False 

End 

Begin VB.Menu mnuAcceptedPaste 
Caption = "Paste profile" 
Enabled = 0 'False 
End 
End 
End 

Attribute VB_Name = "firoTCA" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 



' contains family 



Private mudtFam As Family 
' word 

Private mudtWord As MSWord 

' prolog activex 

Private mudtProlog As Prolog 

' needed for SetAUCheckboxes sub 
Private mlstCurrentListBox As ListBox 

' needed so fimConstraint know which kind of constraint to create 
Private mintConstrLBInd As Integer 

' used as a flag when mnuFilelmportLockedltem calls ninuFileNew 
Private mudtltemType As ItemType 

' holding area for copy / paste of variant profiles 
Private mudtClone As Clone 

' turn full window drag back on if this is TRUE 
Private mblnRestoreFullWindowDrag As Boolean 

Public Enum EditFlags 

aeNothing = 0 

aeAdd = 1 

aeEdit - 2 
End Enum 

Public Enum TestType 

tcTestVariables = 0 

tcTestVariationConstraints = 1 

tcTestDistractorConstraints = 2 

tcTestAll = 4 
End Enum 

' for importing/exporting variables and constraints 
Private Enum ConstraintRecordLayout 

crVariablelndex = 1 ' 4 byte long 

crConstraintlndex = 5 ' 4 byte long 

crVariables = 9 ' binary - variable size 
End Enum 

Private Enum Iconlmage 
imSnowflake = 1 
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imSun = 2 
End Enum 

' used to update status bar 
Private Enum Panellndex 

pnProgramCaption - 1 

pnProgramName = 2 

pnFamilyCaption = 3 

pnFamilyName = 4 

pnAttributesCaption = 5 

pnltemType = 6 

pnGeneric = 7 

pnProximity = 8 

pnActiveModelCaption = 9 

pnActiveModellcon = 10 

pnActiveModelName - 1 1 
End Enum 

Public Property Get FamilyQ As Family 

Set Family = mudtFam 
End Property 

Public Property Let Family(ByVal udtNewValue As Family) 

mudtFam = udtNewValue 
End Property 

Private Sub cmdCancel_Click() 
End Sub 

Private Sub cmdAcceptedCopy_Click() 

Call mnuAcceptedCopy^Click 
End Sub 

Private Sub cmdAcceptedEdit_Click() 

Call mnuAcceptedProfile_Click 
End Sub 
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Private Sub cmdAcceptedPaste_Click() 

Call mnuAcceptedPaste_Click 
End Sub 

Private Sub cmdComments_Click() 

fhnComments.Comment = mudtFam.ActiveModel. Comments 
firmComments.Show vbModal 

mudtFam.ActiveModelComments = frmComments.Comment 
UpdateTab 1 ControlStates 
End Sub 

Private Sub cmdConstraintAdd_Click(index As Integer) 

mintConstrLBInd = index 
Call mnuConstraintsAdd_Click 

End Sub 

Private Sub cmdConstraintEdit_Click(index As Integer) 

mintConstrLBInd = index 
Call mnuConstraintsEdit_Click 

End Sub 

Private Sub cmdConstraintRemove_Click(index As Integer) 

mintConstrLBInd = index 

Call mnuConstraintsRemove_Click 

End Sub 

Private Sub cmdConstraintTest_Click(index As Integer) 

mintConstrLBInd = index 
Call mnuConstraintsTest_Click 

End Sub 

Private Sub cmdDispAccept_Click() 
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Call mnuDispAccept_Click 
End Sub 

Private Sub cmdDispDefer_Click() 

Call mnuDispDefer_Click 
End Sub 

Private Sub cmdDispDiscard_Click() 

Call mnuDispDiscard_Click 
End Sub 

Private Sub cmdDisplayModel_Click() 

Call mudtFam.ActiveModeLOpenDoc(mudtWord) 
End Sub 

Private Sub cmdDispMakeModel_Click() 

Call ninuDispMakeModel_Click 
End Sub 

Private Sub cmdDone_Click() 

Dim inti As Integer 

Dim udtClone As Clone 

Dim dMode As String 

Dim iType As String 

Dim key As String 

Dim Program As String 

Dim root As String 

Dim udtFamIni As New IniFile 

Dim udtProgress As New Progress 

If MsgBox("Prepare this family for export to TCS?", 
vbQuestion + vbYesNo) = vbNo Then 
Exit Sub 

End If 
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If mudtFam.ActiveModel Is Nothing Then 

' do nothing 
Else 

mudtFam.ActiveModel.WriteModel 
End If 

' close this so it can be copied to the out directory 
mudtFam.ActiveModel.CloseDoc 

Call udtProgress.Init(mudtFam.Clones.Count + 2, "Preparing family for exporting to TCS,.. 
udtProgress, Advance 

root ^ ExtractFileNameNoExt(mudtFam,FileName) 
udtFamlni.FN = OUT_DIRECTORY & root & ".ini" 

Select Case mudtFam. Program 
Case prGRE 
Program - "ORE" 

Case prGMAT 
Program = "GMAT" 

Case prSAT 
Program - "SAT" 

Case prMR 

Program = "MR" 
End Select 

Dim udtlnini As New IniFile 

udtlnlni.FN = left(mudtFam.FileName, Len(mudtFam.FileName) - 3) & _ 
"ini" 

Dim strModelNo As String 

' started with a locked item (during this session) 
StrModelNo = udtInIni.GetProfileString("LockedItemData", _ 
"TCAModelNo") 

' started with an existing family (during this session) 
If StrModelNo = "Not Found" Then 

StrModelNo = udtInIni.GetProfileString("Family", _ 
"TCAModelNo") 
End If 
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Call udtFamlni.SetKeyValuePairC'TCAModelNo", strModelNo) 

Call udtFamIni.SetKeyValuePair("LockedAccnum'\ mudtFam.AccNum) 

Call udtFamIni.SetKeyValuePair("Program", Program) 

Dim strProx As String 

Select Case mudtFam.Proximity 
Case prNear 

StrProx = "close" 
Case prMedium 

StrProx = "medium" 
Case prFar 
StrProx = "far" 
End Select 

Call udtFamIni.SetKeyValuePair("Proximity", strProx) 

If mudtFam. Generic Then 

Call udtFamIni.SetKeyValuePair("Nature", "generic") 
Else 

Call udtFamIni.SetKeyValuePair("Nature", "non-generic") 
End If 

For Each udtClone In mudtFam. Clones 

udtClone.CloseDoc 

If udtClone.IsRouted = False Then 

dMode = "TCA" 
iType = "TCA" 

Call FileCopy(IN_DIRECTORY & udtClone.FileName, _ 
OUT_DIRECTORY & udtClone.FileName) 

Else 

If udtClone.DeliveryMode dmPPT Then 

dMode = "PPT" 
Else 

dMode = "CBT" 
End If 

Call udtClone.OpenDoc(mudtWord, IN__DIRECTORY) 
Select Case mudtFam.ItemType 
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Case ptStandardMC 
IfdMode = "PPT" Then 
ilype = "MC Item" 

Call genPPT_MultChoice(udtClone, key) 
Else 

iType = "QANTDISC" 
Call genCBT_MultChoice(udtClone, key) 
End If 

Case ptQuantComp 
IfdMode = "PPT" Then 

iType = "QC Discrete" 

Call genPPT_QuantComp(udtClone, key) 
Else 

iType = "QANTCOMP" 
Call genCBT_QuantComp(udtClone, key) 
End If 

Case ptDataSuff 

iType = "DATASUFF" 

Call genCBT_DataSuff(udtClone, key) 

End Select 

udtClone.CloneDoc. Close 
End If 

Dim udtClnIni As New IniFile 

root = ExtractFileNameNoExt(udtClone.FileName) 
Call udtFamIni.SetKeyValuePair("Variant", root) 

udtClnlni.FN = OUT_DIRECTORY & root & ".ini" 

Call udtClnIni.SetKeyValuePair("DeliveryMode", dMode) 
Call udtClnlni.SetKeyValuePairC'Key", udtClone.key) 
Call udtClnIni.SetKeyValuePair("ItemType", iType) 
CalludtClnIni.WriteProfileSection("Variant") 
Call udtClnIni.WriteProfileString("Exit", " ", " ") 

Set udtClnIni = Nothing 

udtProgres s .Advance 
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Next udtClone 



' delete profiled variants from IstAccepted 
With IstAccepted 
inti = .ListCount - 1 
Do While intl>-l 

Set udtClone = mudtFam.Clones.Item(Str(.ItemData(intI))) 
If udtClone.IsRouted Then 

' remove the clone from the collection 
Call mudtFam.Clones.Remove(Str(.ItemData(intI))) 
' remove it from the list box 
Call .Removeltem(intl) 
End If 
intI = intI - 1 
Loop 
End With 

mudtFam.WriteFamily 

Dim flSTame As String 
Dim strWildCard As String 

For intI = 1 To freModels.Nodes. Count 

root = ExtractFileNameNoExt(treModels.Nodes .Item(intl)) 

fName = root & ".doc" 

Call udtFamIni.SetKeyValuePair("Member", fName) 

Call FileCopy(IN_DIRECTORY & fName, OUT_DIRECTORY & fName) 

fName = root & ".mdl" 

Call udtFamIni.SetKeyValuePair("Member", fName) 

Call FileCopy(IN_DIRECTORY & fName, OUT_DIRECTORY & fName) 

Ifintl= 1 Then 

fName = root & ".mdf ' 
StrWildCard = root &"*.*" 

Call udtFamIni.SetKeyValuePair("Member", fName) 
Call FileCopy(IN_DIRECTORY & fName, OUT_DIRECTORY & fName) 
End If 

Next 

Call udtFamlni.WriteProfileSectionC'Family") 
Call udtFamlni.WriteProfileStringC'Exit", " ", " ") 
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ClearControls 

mudtWord.WordApp.Documents.Open FileName:=App.path & "\tcaclone.doc" 
mudtWord.WordApp.Documents.Close 

Kill IN_DIRECTORY & strWildCard 

If strModelNo o "Not Found" Then 

Kill IN_DIRECTORY & strModelNo & ".*" 
End If 

udtProgress.Advance 
UpdateTabOControlStates 
End Sub 

Private Sub genPPT_MultChoice(udtClone As Clone, itmKey As String) 
Dim docTCAModel As Document 

Set docTCAModel = mudtWord.WordApp.Documents.Open(App.path & "\TCAClone.DOC") 

docTCAModel.Variables.Add "PROP_ACCNUM", "SSMCPPT" 

' mudtWord.WordApp.Run ("SetAccnum") 
mudtWord.WordApp.Run("StartItem.Main") 

Dim tabchr As String 

tabchr = Chr(9) 

Dim destRange As Range 

Set destRange = docTCAModel. Content 

destRange.fmd.StyIe = "PPTStem" 

destRange . find.Execute FindText :=tabchr 

' MsgBox "PPT MultChoice" 

udtClone.CloneDoc.Bookmarks("tca_Stem").Range.Copy 
destRange.Paste 

destRange.Borders.Enable = False 

destRange.ParagraphFormat.LeftIndent = InchesToPoints(0.25) 
destRange. Style = "PPTStem" 

Dim respRange As Range 
Dim abcde As String 
abcde = "ABCDE" 
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10 



Dim i As Integer 
For i = 1 To 5 

Set respRange = udtClone.CloneDoc.Bookmarks("tca_Resp" & Mid(abcde, i, l)).Range 

respRange.start = respRange. start + 4 

respRange.Copy 

Set destRange = docTCAModel Content 
destRange.find.Style = "PPTOptions" 
destRange.find.Execute FindText:="(" & Mid(abcde, i, 1) & 
destRange.start = destRange. start + 4 
destRange.Paste 

destRange.Borders. Enable = False 

destRange.ParagraphFormat.Leftlndent InchesToPoints(0.25) 
destRange.Style = "PPTOptions" 

Next 



1 5i Dim key As String 

key ^ udtClone.CloneDoc.Bookmarks("tca_Key").Range.Text 
U] key = Mid(key, 8, 1) 

4 : itmKey = key 

4 = For i = 1 To 5 

If key = Mid(abcde, i, 1) Then 
key = Format(i) 
^ Exit For 

% End If 

l1 Next 

2f] Dim keyRange As Range 

Dim keyStart As Long 
Set keyRange = docTCAModel. Content 
keyStart = keyRange.End - 1 

docTCAModel.Content.InsertAfter Text:=itmKey 
30 keyRange.SetRange start:=-keyStart, End:=docTCAModel.Content.End 

' docTCAModel.Bookmarks.Add Name:="prop_Key", Range :=keyRange 

Dim tmpFName As String 

tmpFName = OUT_DIRECTORY & udtClone.FileName 

docTCAModel.VariablesCTROP_ACCNUM").Delete 
35 docTCAModel. Variables.Add "PROP_ACCNUM", "TCAVARNT" 
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docTCAModel.SaveAs tmpFName 
docTCAModelClose 

End Sub 

Private Sub genCBT_MultChoice(udtClone As Clone, itmKey As String) 
Dim docTCAModel As Document 

Set docTCAModel - mudtWord.WordApp.Documents.Open(App.path & "\TCAClone.DOC") 

' MsgBox "CBT MultChoice" 

docTCAModel Variables.Add 'TROP_ACCNUM", "SSMCCBT" 
' mudtWord.WordApp.Run ("SetAccnum") 
mudtWord.WordApp.Run ("Startltem.Main") 

Dim tabchr As String 

tabchr = Chr(9) 

Dim destRange As Range 

Set destRange = docTCAModelContent 

destRange,find,Execute FindText:=" Enter stem here." 

udtClone.CloneDoc.Bookmarks("tca_Stem").Range.Copy 
destRange.Paste 

destRange.Borders. Enable = False 

Dim respRange As Range 
Dim abcde As String 
abode - "ABCDE" 
Dim i As Integer 

Set destRange - docTCAModelContent 
destRange.fmd. Execute FindText:="Enter responses here" 
destRange.End = destRange.End + 1 
destRange.Delete 

For i = 1 To 5 

Set respRange = udtClone.CloneDoc.Bookmarks("tca_Resp" & Mid(abcde, i, l)).Range 
respRange. start = respRange. start + 4 
respRange. Copy 

destRange.Paste 
destRange.Style = "Choice" 
destRange.InsertParagraphAfter 
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Set destRange ^ destRange,Paragraphs(l).Next.Range 
Next 

Dim key As String 

key = udtClone.CloneDoc.Bookmarks("tca_Key").Range,Text 
key-Mid(key, 8, 1) 
itmKey = key 

For i = 1 To 5 
If key = Mid(abcde, i, 1) Then 
key = Format(i) 
Exit For 
End If 
Next 

Dim keyRange As Range 

Dim keyStart As Long 

Set keyRange ^ docTCAModeL Content 

keyStart ^ keyRange.End - 1 

docTCAModeL Content JnsertAfter Text:=itmKey 
keyRange.SetRange start:=keyStart, End:=docTCAModeLContent.End 
' docTCAModel.Bookmarks.Add Name:="prop_Key", Range:=keyRange 

Dim tmpFName As String 

tmpFName = OUT_DIRECTORY & udtClone.FileName 

docTCAModel.VariablesCTROP_ACCNUM").Delete 
docTCAModel.Variables.Add 'TROP_ACCNUM", "TCAVARNT" 
Call itemKey_Store(docTCAModel, udtClone.key) 
docTCAModel.SaveAs tmpFName 
docTCAModelClose 

End Sub 

Private Sub genPPT_QuantComp(udtClone As Clone, itmKey As String) 
Dim docTCAModel As Document 

Set docTCAModel = mudtWord.WordApp.Documents.Open(App,path & "\TCAClone.DOC") 
' MsgBox "PPT QuantComp" 

docTCAModel. Variables.Add "PROP_ACCNUM", "QCPPT" 
' mudt Word, WordApp. Run ("SetAccnum") 
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mudtWord.WordApp.Run("StartItem,Main") 



udtClone.CloneDoc3ookmarks("tca_Stem'').Range.Copy 
docTCAModel.Tables(l).Cell(Row:=l, Column:=2).Range.Paste 

docTCAModel.Tables(l).Cell(Row:=l, Column:=2).Range.Style = "PPTQC StimCentered" 

udtClone.CloneDoc.Bookinarks(''tca_ColumnA"),Range.Copy 
docTCAModel.Tables(l).Cell(Row:=2, Column:-2).Range.Paste 

udtClone.CloneDoc3ookmarks("tca_ColumnB'').Range.Copy 
docTCAModel.Tables(l).Cell(Row:=2, Column:=4).Range.Paste 

docTCAModel.Tables(l).Cell(Row:-2, Column:=2).Range.Style - "PPTQC AB" 
docTCAModel.Tables(l).Cell(Row:=2, Column:=4).Range.Style = "PPTQC AB" 

Dim key As String 

key = udtClone.CloneDoc.Bookmarks("tca_Key"),Range.Text 
key = Mid(key, 8, 1) 
itmKey = key 

Dim abode As String 
abode = "ABCDE" 
Dim i As Integer 

For i = 1 To 5 
If key Mid(abode, i, 1) Then 
key = Format(i) 
Exit For 
End If 
Next 

Dim keyRange As Range 

Dim keyStart As Long 

Set keyRange = docTCAModel.Content 

keyStart = keyRange.End - 1 

docTC AModel . Content insert After Text : =itmKey 
keyRange.SetRange start:=keyStart, End:=dooTCAModel.Content.End 
dooTCAModel.Bookmarks.Add Name:="prop_Key", Range :=keyRange 

Dim tmpFName As String 

tmpFName - OUT_DIRECTORY & udtClone.FileName 

docTCAModeLVariables("PROP_ACCNUM").Delete 
docTCAModel.Variables.Add "PROP_ACCNUM", "TCAVARNT" 
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docTCAModel.SaveAs tmpFName 
docTCAModel.Close 

End Sub 

Private Sub genCBT_QuantComp(udtClone As Clone, itmKey As String) 
Dim docTCAModel As Document 

Set docTCAModel - mudtWord.WordApp.Documents.Open(App.path & "\TCAClone.DOC") 

' MsgBox "CRT QuantComp" 

docTCAModel. Variables.Add 'TROP_ACCNUM", "QCCBT" 
' mudtWord.WordApp.Run ("SetAccnum") 
mudtWord.WordApp.Run f Startltem.Main") 

udtClone.CloneDoc.Bookmarks("tca_Stem").Range.Copy 
docTCAModeLTables(l).Cell(Row~l, Column:-! ).Range.Paste 

udtClone,CloneDoc.Bookmarks("tca_ColumnA").Range.Copy 
docTCAModeLTables(l),Cell(Row:-2, Column:=l).Range.Paste 

udtClone.CloneDoc.Bookmarks("tca_ColumnB").Range.Copy 
docTCAModel.Tables(l).Cell(Row:=2, Column:=2).Range.Paste 

Dim key As String 

key - udtClone.CloneDoc.Bookmarks("tca_Key").Range.Text 
key = Mid(key, 8, 1) 
itmKey = key 

Dim abcde As String 
abcde - "ABCDE" 
Dim i As Integer 

For i = 1 To 5 
If key = Mid(abcde, i, 1) Then 
key = Format(i) 
Exit For 
End If 
Next 

Dim keyRange As Range 

Dim keyStart As Long 

Set keyRange = docTCAModel. Content 

keyStart = keyRange.End - 1 
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docTCAModel.Content.InsertAfter Text:^itmKey 
keyRange.SetRange start:=keyStart, End:=docTCAModel.Content.End 
' docTCAModel.Bookmarks.Add Name:=="prop_Key", Range :=keyRange 

Dim tmpFName As String 

tmpFName = OUT_DIRECTORY & udtClone.FileName 

docTCAModeLVariables("PROP_ACCNUM").Delete 
docTCAModel.Variables.Add 'TROP_ACCNUM", "TCAVARNT" 
Call itemKey_Store(docTCAModel, udtClone.key) 
docTCAModel.SaveAs tmpFName 
docTCAModelClose 

End Sub 

Private Sub genCBT_DataSuff(udtClone As Clone, itmKey As String) 
Dim docTCAModel As Document 

Set docTCAModel - mudtWord,WordApp.Documents.Open(App.path & "\TCAClone.DOC") 

' MsgBox "CBT DataSuff ' 

docTCAModel.Variables.Add »TROP_ACCNUM", "DSCBT" 
' mudtWord.WordApp.Run ("SetAccnum") 
mudtWord.WordApp.Run ("Startltem.Main") 

Dim tabchr As String 

tabchr=Chr(9) 

Dim destRange As Range 

Set destRange = docTCAModel.Content 

destRange.fmd.Execute FindText:=" Enter stem here." 

udtClone.CloneDoc.Bookmarks("tca_Stem").Range.Copy 
destRange. Paste 

' destRange.Borders. Enable = False 

' destRange.ParagraphFormat.Leftlndent = InchesToPoints(0.25) 
Set destRange = docTCAModel.Content 

destRange.find. Execute FindText:="Enter Data Sufficiency Statement 1 here, then press 
return." 

' udtClone.CloneDoc.Bookmarks("tca_fStatement").Range.Copy 
Dim srcRange As Range 

Set srcRange = udtClone.CloneDoc.Bookmarks("tca_fStatement"). Range 
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srcRange.End = srcRange.End - 1 
If Len(srcRange.Text) > 0 Then 

srcRange.Copy 

destRange.Paste 
End If 

destRange. Collapse Direction: =wdCollapseEnd 

destRange . InsertP aragraphAfter 

destRange. Collapse Direction:=wdCollapseEnd 

Set srcRange = udtClone.CloneDoc.Bookmarks("tca_sStatement").Range 
srcRange.End = srcRange.End - 1 
If Len(srcRange.Text) > 0 Then 

srcRange.Copy 

destRange.Paste 
End If 

Dim n As Integer 

n = docTCAModel.ListParagraphs. Count 
While n > 2 

Set destRange = docTCAModel.ListParagraphs(n).Range 
destRange.Delete 
n = n - 1 
Wend 

Dim key As String 

key = udtClone.CloneDoc.Bookmarks("tca_Key").Range.Text 
key = Mid(key, 8, 1) 
itmKey = key 

Dim abcde As String 
abcde = "ABCDE" 
Dim i As Integer 

For i ^ 1 To 5 
If key - Mid(abcde, i, 1) Then 
key = Format(i) 
Exit For 
End If 
Next 

Dim keyRange As Range 

Dim keyStart As Long 

Set keyRange = docTCAModel. Content 

keyStart = keyRange.End - 1 
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docTCAModelContent.InsertAfter Text:=itmKey 
keyRange.SetRange start:=keyStart, End:=docTCAModel.Content.End 
' docTCAModel.Bookmarks.Add Name:="prop_Key", Range :=keyRange 

Dim tmpFName As String 

tmpFName = OUT_DIRECTORY & udtClone.FileName 

docTCAModeLVariablesCTROP_ACCNUM").Delete 
docTCAModel.VariablesAdd 'TROP_ACCNUM", "TCAVARNT" 
Call itemKey_Store(docTCAModel, udtClone.key) 
docTCAModelSaveAs tmpFName 
docTCAModel.Close 

End Sub 

Private Sub itemKey_Store(doc As Document, ByVal key As String) 

Dim i As Integer 

For i = 1 To 5 
If key = Mid("ABCDE", i, 1) Then 
key = Format(i) 
Exit For 
End If 
Next 

doc.Variables.Add "ItemKeyStore", key 
End Sub 

Private Sub cmdPrintConstraints_Click() 

Dim udtV As Variable 
Dim udtC As Constraint 
Dim udtVI As Varlnteger 
Dim udtVR As VarReal 
Dim udtVF As VarFraction 
Dim udtVS As VarString 
Dim udtP As New PrintModel 
Dim varS As Variant 
Dim varSl As Variant 
Dim udtSS As Substring 
Dim inti As Integer 

udtP.ModelName = ExtractFileNameNoExt(mudtFam.ActiveModeLFileName) 
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Call udtP.PrintStringC'Variables:", 1) 

For Each udtV In mudtFam.ActiveModel.Variables 

Call udtP.PrintStringC'Variable name: " & udtV.name, 2) 
Select Case udtV.Typ 
Case vtlnteger 

Call udtP.PrintString("Type: Integer", 3) 
Case vtReal 

Call udtP.PrintStringC'Type: Real", 3) 
Case vtFraction 

Call udtP.PrintString("Type: Fraction", 3) 
Case vtString 

Call udtP.PrintString("Type: String", 3) 
Case vtUntyped 
Call udtP.PrintString("Type: Untyped", 3) 
End Select 

If udtV.Enabled Then 

Call udtP.PrintString("Status: Enabled", 3) 
Else 

Call udtP.PrintString("Status: Disabled", 3) 
End If 

If udtV.Checksum Then 

Call udtP.PrintString("Checksum: Enabled", 3) 
Else 

Call udtP.PrintString("Checksum: Disabled", 3) 
End If 

Select Case udtV.Typ 
Case vtlnteger 
Set udtVI = udtV 
If udtVI.IsIndependent Then 

Call udtP. Prints tring("Is independent = True," & 
" Range: from " & udtVI.From & _ 
" to "&udtVI.Too&_ 
" by " & udtVI-By, 3) 

Else 

Call udtP.PrintString("Is independent = False", 3) 
End If 
Case VtReal 

Set udtVR = udtV 

If udtVR.IsIndependent Then 

Call udtP.PrintString("Is independent = True," & 
" Range: from " & udtVR.From & _ 
" to " & udtVR.Too & _ 
" by " & udtVR.By, 3) 
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Else 

Call udtP.PrintStringC'Is independent = False", 3) 
End If 

If udtVR.IsOnGrid Then 

Call udtP.PrintStringC'Force on grid value: True", 3) 
Else 

Call udtP.PrintString("Force on grid value: False", 3) 
End If 

Call udtP.PrintString("# Decimal places: " & _ 

Str(udtVR.DecimalPlaces), 3) 
If udtVR.TrailingZeros Then 

Call udtP.PrintString("Display trailing zeros: True", 3) 
Else 

Call udtP.PrintString("Display trailing zeros: False", 3) 
End If 
Case vtFraction 
Set udtVF = udtV 
If udtVF Jslndependent Then 

Call udtP.PrintString("Is independent = True," & _ 
" Range: from " & udtVF.FromNumerator & _ 
"/" & udtVF-FromDenominator & _ 
" to " & udtVF.ToNumerator & _ 
"/" & udtVF.ToDenominator & _ 
" by " & udtVF.ByNumerator & _ 
"/" & udtVF.ByDenominator, 3) 

Else 

Call udtP.PrintString("Is independent = False", 3) 
End If 

If udtVF.MixedNumbers Then 

Call udtP. Prints tring("Display mixed number: True", 3) 
Else 

Call udtP.PrintString("Display mixed number: False", 3) 
End If 
Case vtString 
Set udtVS = udtV 
If udtVSTsIndexed Then 

Call udtP.PrintString("Indexed: True", 3) 
Call udtP.PrintString("Value Sets:", 3) 
For Each varS In udtVS.StringCoUection 
Set udtSS == New Substring 
udtSS.Delimiter = Chr(STRING_DELIMITER) 
udtSS.StringValue = varS 
Call udtP.PrintString(" Values:", 4) 
inti = 1 

For Each varSl In udtSS.StringCoUection 
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Call udtP.PrintString(Str(intI) & ". " & varSl, 5) 
inti = inti + 1 
Next varSl 
Next varS 
Else 

Call udtP.PrintStringC'Indexed: False", 3) 

Call udtP.PrintStringC'Values:", 3) 

For Each varS In udtVS.StringCollection 

Call udtP.PrintString(varS, 4) 
Next varS 
End If 
Case vtUntyped 
End Select 

Next udtV 

Call udtP.PrintStringC'Constraints:", 1) 

Call udtP.PrintStringC'Variation constraints:", 2) 

For Each udtC In mudtFam.ActiveModel.Constraints 
If udtC.ConstraintType = ctVariation Then 

Call udtP.PrintString("Constraint: " & udtC.ConstraintString, 3) 
IfudtCEnabledThen 

Call udtP.PrintString("Status: Enabled", 4) 
Else 

Call udtP.PrintString("Status: Disabled", 4) 
End If 
End If 
Next udtC 

'exit if not MC 

If Not mudtFam.ItemType = ptStandardMC Then Exit Sub 

Call udtP.PrintString("Distractor constraints:", 2) 

For Each udtC In mudtFam.ActiveModel. Constraints 
If udtC.ConstraintType = ctDistractor Then 

Call udtP.PrintString("Constraint: " & udtC.ConstraintString, 3) 
IfudtC.Enabled Then 

Call udtP.PrintString("Status: Enabled", 4) 
Else 

Call udtP.PrintString("Status: Disabled", 4) 
End If 
End If 
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Next udtC 



End Sub 

Private Sub cmdSetAttributes_Click() 
frmAttributes.Show vbModal 

If fmiAttributes.OK Then 

mudtFam.Generic = fmiAttributes. Generic 

mudtFam.Proximity = frm Attributes, Proximity 

mudtFam.IsDirty = True 

' save family 

mudtFam.WriteFamily 

UpdateFamily Attributes 
End If 

End Sub 

Private Sub cmdTreeExtend_Click() 

Call mnuTreeExtend_Click 
End Sub 

Private Sub cmdTreeRemove_Click() 

Call mnuTreeRemove_Click 
End Sub 

Private Sub cmdVariableAdd_Click() 

Call mnuVariablesAdd_Click 

frmVariable. Model = mudtFam. ActiveModel 

frmVariable.ListBox = IstVariables 

frmVariable. Show vbModal 

UpdateTab 1 ControlStates 

End Sub 

Private Sub cmdVariableEdit_Click() 
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Call mnuVariablesEdit_Click 
frmVariable.Model = mudtFam.ActiveModel 
frmVariable.ListBox = IstVariables 

If IstVariablesXistlndex >^ 0 Then ' Make sure list item is selected 
' Set the key for access by frmVariable 
With IstVariables 

frmVariable. Variable = _ 
mudtFam.ActiveModel Variables.Item(Str(JtemData(.ListIndex))) 
End With 

frmVariable.Show vbModal 
End If 

UpdateTab 1 ControlStates 
End Sub 

Private Sub cmdVariableRemove_CHck() 

Call mnuVariablesRemove_Click 
End Sub 

Private Sub cmdVariableTest__Click() 

Call mnuVariablesTest_Click 
End Sub 

Private Sub Fonn_Initialize() 

fhnSplash.Show 
End Sub 

Private Sub Form_Load() 

' to trap cancels 
cdlCD.CancelError = True 

'Create Word Object 

Set mudtWord = New MSWord 

' get rid of the kill file if it exists, as it will prevent 
' StartProlog from working 
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DestroyKillFile 

' Create the Prolog object 

If mudtProlog Is Nothing Then 

Set mudtProlog = CreateObject("AXProlog.Prolog") 

If Not mudtProlog.StartProlog Then 

Call MsgBox("Prolog cannot be started.", vbExclamation, "Prolog error") 

End If 
End If 

treModels.ImageList = imll 
frmSplash.UnloadMe 
Me. Show 

UpdateTabOControlStates 

' ' copies ied files from a holding area, as TCS deletes them for 

' ' reasons unknown, 

• Call Kill("c:\tcs\working\*.ied") 

' Call FileCopy("c:\tcs\tcaied\dscbt.ied", "c:\tcs\working\dscbt.ied") 

' Call Shell("attrib -r c:\tcs\working\dscbt.ied", vbHide) 

' Call FileCopy("c:\tcs\tcaied\qccbt.ied", "c:\tcs\working\qccbt.ied") 

' Call FileCopy("c:\tcs\tcaied\qcppt.ied", "c:\tcs\working\qcppt.ied") 

' Call FileCopy("c:\tcs\tcaied\ssmccbt.ied", "c:\tcs\working\ssmccbt.ied") 

' Call FileCopy("c:\tcs\tcaied\ssmcppt.ied", "c:\tcs\working\ssmcpptjed") 

End Sub 

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 

Call sstMainTab_MouseMove(Button, Shift, X, Y) 
End Sub 

Private Sub Form_Resize() 
' if minimized, don't resize 

If Me.WindowState = vbMinimized Then Exit Sub 

Dim udtW As New Win32API 
Dim result As Long 

Turn off full window drag if it's on 
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If udtW.IsFuUWindowDragOn Then 

udtWTumOffFullWindowDrag 

mblnRestoreFullWindowDrag = True 
End If 

' adjust horizontals 
fraWord.left-120 

fraWord. Width = Me, Width - sstMainTab. Width - 360 
sstMainTab.left = fraWord. Width + 180 

'adjust verticals 

fraWord.Height = Me.Height - fraWord.top - stbS.Height - 700 ' approx title bar height 
sstMainTab.Height ^ fraWord.Height 

mudtWord.Resize 

End Sub 

Private Sub Form_Unload(Cancel As Integer) 

' if no active family, hit the road 
If mudtFam Is Nothing Then 

' do nothing 
Else 

mudtFam.WriteFamily 

If mudtFam. ActiveModel Is Nothing Then ' see if an active model has been set 

' do nothing 
Else 

mudtFam.ActiveModel.CloseDoc 
KillVariants ' Get rid of any variants left on tab 3 
mudtFam.ActiveModel.WriteModel ' save the active model 
End If 
End If 

' close all docs 
mudtWord.CloseAllDocs 

' Kill Word before firmTCA is unloaded to prevent automation error 
Set mudtWord = Nothing 

' force event 

Call sstMainTab_MouseMove(l, 1,1,1) 

' To cleanly shut down AXProlog on W9 5, 98 boxes 
mudtProlog.EndProlog 
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' End required by NT 4,0 to shut down TCA successfully! 
End 

End Sub 

Private Sub IstVariables_ItemCheck(Item As Integer) 

With IstVariables 

If IstVariablesXistCount - 0 Then Exit Sub ' this prevents an error 
If mudtFam.ActiveModel.IsFrozen Then 
.Selected(Item) =_ 
mudtFam.ActiveModel.VariablesJtem(Str(JtemData(Item))).Enabled 

Else 

mudtFanaActiveModel.Variables.Iteni(Str(.IteniData(Iteni))).Enabled = _ 
.Selected(Item) 
End If 
End With 

UpdateTab 1 ControlStates 
End Sub 

Private Sub lstVariables_MouseDown(Button As Integer, Shift As Integer, _ 
X As Single, Y As Single) 

Dim strlndex As String 

Set mlstCurrentListBox ^ IstVariables 

If Button = vbRightButton Then 

frmVariable. AddEditFlag = aeNothing 

PopupMenu mnuVariables ' Pull up popup menu for variable window 
frmVariable.Model = mudtFam.ActiveModel 
frmVariable.ListBox = IstVariables 
Select Case frmVariable.AddEditFlag 
Case aeEdit 

If IstVariables.Listlndex >= 0 Then ' Make sure list item is selected 
' Set the key for access by frmVariable 
With IstVariables 
frmVariable. Variable 

mudtFam.ActiveModel.Variables.Item(Str(.ItemData(.ListIndex))) 

End With 

frmVariable.Show vbModal 
End If 
Case aeAdd 
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frmVariable.Show vbModal 
End Select 
End If 

End Sub 

Private Sub lstConstraints_ItemCheck(index As Integer, Item As Integer) 

Dim strKey As String 

With IstConstraints(index) 

If XistCount = 0 Then Exit Sub ' prevents error if Ustbox is empty 
If mudtFam. ActiveModel.IsFrozen Then 
.Selected(Item) = _ 
mudtFamActiveModel.Constraints.Item(Str(.ItemData(Item))).Enabled 

Else 

mudtFam.ActiveModelConstraints.Item(Str(.ItemData(Item))).Enabled = 
.Selected(Item) 
End If 
End With 

UpdateTab 1 ControlStates 
End Sub 

' provide right button menu options 

Private Sub lstConstraints_MouseDown(index As Integer, Button As Integer, _ 
Shift As Integer, X As Single, Y As Single) 

Dim strlndex As String 

Set mlstCurrentListBox = IstConstraints(index) 
mintConstrLBInd = index 

Call UpdateTab 1 ControlStates(index) 

If Button = vbRightButton Then 

PopupMenu mnuConstraints 
Else 

If mudtFam.ActiveModel.IsFrozen = False Then 

lstConstraints(index).Drag 
End If 
End If 

End Sub 
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' Enable drag and drop between constraint list boxes 

Private Sub lstConstraints_DragDrop(index As Integer, Source As Control, _ 
X As Single, Y As Single) 

If Source.ListCount ^ 0 Then 

Exit Sub 
End If 

If index <> Source.index Then ' Assure that it's another listbox! 

Dim udtConstraint As Constraint 
Dim strKey As String 

strKey = Str(Source,IteniData(Source.ListIndex)) 

With IstConstraints(index) 

' Add the dragged constraint to the end of the target listbox 

.List(.ListCount) = Source.List(Source.Listlndex) 

' Update the index in the new listbox entry 

JtemData(.ListCount - 1) = Source.ItemData(Source,ListIndex) 
End With 

' Find the constraint object being moved and update it's "type" in the collection 
Set udtConstraint = mudtFam.ActiveModeLConstraints.Item(strKey) 
udtConstraint.ConstraintType = index 

' Delete the dragged constraint from the source listbox 
Call Source.Removeltem(Source.Listlndex) 

End If 

UpdateTab 1 ControlStates 
End Sub 

Private Sub lstDisposition_MouseDown(Button As Integer, Shift As Integer, _ 
X As Single, Y As Single) 

Dim udtClone As Clone 

If Button = vbRightButton Then 

PopupMenu mnuDisp 
Else 

With IstDisposition 

If .ListCount > 0 Then ' a vahd selection has been made 
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Set udtClone = mudtFam.ActiveModel.Clones.Item(Str(.ItemData(.ListIndex))) 
Call udtClone.OpenDoc(mudtWord, IN_DIRECTORY) 
End If 
End With 
End If 
End Sub 

Private Sub lstAccepted_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As 
Single) 

Static udtClone As Clone 

If Button = vbRightButton Then 
' With IstAccepted 

If .SelCount= 1 Then 
' mnuAcceptedProfile. Enabled = True 

' mnuAcceptedCopy.Enabled = True 

Set udtClone = mudtFam.Clones.Item(Str(.IteniData(.ListIndex))) 
Call udtClone.OpenDoc(mudtWord, IN_DIRECTORY) 
' Set udtClone Nothing 

' Else 

' mnuAcceptedProfile.Enabled = False 

' mnuAcceptedCopy.Enabled = False 

End If 
End With 

PopupMenu mnuAccepted 
Else ' left button chck 

If udtClone Is Nothing Then 

' do nothing 
Else 

udtClone.CloseDoc 
Set udtClone = Nothing 
End If 

With IstAccepted 
If .ListCount>OThen 

Set udtClone = mudtFam.Clones.Item(Str(.ItemData(.ListIndex))) 
Call udtClone.OpenDoc(mudtWord, IN_DIRECTORY) 
End If 
End With 
End If 

UpdateTabOControlStates 
End Sub 
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Private Sub cmdSaveModel_Click() 

If mudtFam.ActiveModel.IsDirty Then 

mudtFam.ActiveModelWriteModel 

KillVariants 'delete any variants on tab 3 
End If 

UpdateTab 1 ControlStates 
End Sub 

Private Sub cmdTestAll_Click() 

cmdSaveModel_Click ' force a save 
Call TestConstraints(tcTestAll) 

End Sub 

Private Sub cmdImportConstraints_Click() 

Dim strFN As String 

With cdlCD 
.FileName = "" 
.CancelError = Trae 

.DialogTitle = "Import constraints from file" 

.Filter = "Constraint Files (*.con)|*.con|" 

.DefaultExt="xon" 

JnitDir = "c:\tcs\tca\constraints" 

.Flags - cdlOFNFileMustExist + cdlOFNHideReadOnly 
On Error GoTo Cancel ' trap the Cancel button 
.ShowOpen 

On Error GoTo 0 ' reset the error 
StrFN = .FileName 
End With 

' exit if there's no file name 

IfLen(strFN) = OThen 

Exit Sub 
End If 

' create a new collection of imported variables 
Dim udtCVariables As New CVariables 
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Call udtCVariables.ReadCollection(strFN, crVariablelndex, crConstraintlndex) 

' add the imported variables to the main collection 

Dim udtNewVar As Variable 

For Each udtNewVar In udtCVariables 

If mudtFam. ActiveModel. Variables.UniqueName(udtNewVar.name) Then 
CallmudtFam.ActiveModel.Variables.AddObject(udtNewVar) 
With IstVariables 

' Add the new variable to the variable list box 
Call .Addltem(udtNewVar.ScreenFormat) 
' Set ItemData to index value of the variable object 
.ItemData(.ListCount - 1) = udtNewVar.index 
' Set the check box. 

.Selected(.ListCount - 1) = udtNewVar.Enabled 
End With 
Else 

Call MsgBox("Variable " & udtNewVar.name & " will not be imported,", _ 
vbExclamation, "Variable not unique") 
End If 

Next udtNewVar 

' read the imported constraints into a new collection 
Dim udtCConstraints As New CConstraints 

Call udtCConstraints.ReadCollection(strFN, crConstraintlndex, READ_UNTIL_EOF) 

' add the imported constraints 

Dim udtNewCon As Constraint 

For Each udtNewCon In udtCConstraints 

If mudtFam.ActiveModeLConstraints,UniqueConstraint(udtNewCon.ConstraintString) 

Then 

Call mudtFam.ActiveModeLConstraints.AddObject(udtNewCon) 
With IstConstraints(udtNewCon.ConstraintType) 

' Add the new variable to the variable hst box 

Call .AddItem(udtNewCon,ConstraintString) 

' Set ItemData to index value of the variable object 

,ItemData(.ListCount - 1) = udtNewCon. index 

' Check the check box 

.Selected(.ListCount - 1) = udtNewCon.Enabled 
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End With 
Else 

Call MsgBox("Constraint " & udtNewCon.ConstraintString & " will not be imported." 
vbExclamation, "Constraint not unique") 
End If 
Next udtNewCon 

Cancel: 
Exit Sub 

End Sub 

Private Sub cmdExportConstraints_Click() 

Dim strFN As String 

With cdlCD 
.FileName = "" 

.DialogTitle ^ "Export constraints to file" 
.Filter = "Constraint Files (*.con)|*.con|" 
.DefaultExt = ".con" 
.InitDir = "c:\tcs\tca\constraints" 

.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly 
On Error GoTo Cancel ' trap the Cancel button 
.ShowSave 

On Error GoTo 0 ' reset 
strFN = .FileName 
End With 

Dim IngEndPos As Long 

IfLen(strFN)>OThen 

IngEndPos = mudtFam.ActiveModel.Variables.WriteCollection(strFN, crVariablelndex, 
crVariables) 

Call mudtFam.ActiveModel. Constraints. WriteCollection(strFN, crConstraintlndex, 
IngEndPos) 
End If 

Cancel: 
Exit Sub 

End Sub 

Private Sub cmdPrintBatch__Click() 
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Dim blnTF As Boolean 
Dim udtClone As Clone 

If mudtWord. WordApp.Documents.Count = 0 Then 

mudtWord.WordApp.Documents.Open FileName:=App.path & "\printing.doc" 

blnTF = True 
End If 

For Each udtClone In mudtFam.Clones 

mudtWord.WordApp.PrintOut FileName:=IN__DIRECTORY & udtClone.FileName 
Next udtClone 

If blnTF Then 

mudtWord.WordApp.Documents. Close 
End If 

End Sub 

Private Sub cmdPrintVariants_Click() 

Dim blnTF As Boolean 
Dim udtClone As Clone 

If mudtWord.WordApp.Documents.Count = 0 Then 

mudtWord. WordApp.Documents.Open FileName:=App.path & "\printing.doc" 

blnTF = True 
End If 

For Each udtClone In mudtFam.ActiveModel. Clones 

mudtWord.WordApp.PrintOut FileName:=IN__DIRECTORY & udtClone.FileName 
Next 

If blnTF Then 

mudtWord.WordApp.Documents. Close 
End If 

End Sub 

Private Sub cmdGenerate_Click() 
Dim udtClone As New Clone 

Me.Enabled = False ' disable frmTCA to make next form seem modal 
frmProlog. Caption = "Generating " & txtNum2Generate & " variants" 
firmProlog.lblProlog.Caption = "Chck Abort to terminate variant generation." 
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frmProlog.Show ' show form modeless so execution continues 
Me.MousePointer = vbHourglass 

Call mudtFam.ActiveModeLGenerateClones(mudtWord, mudtProlog, _ 

CInt(txtNum2Generate), sldDifference) 
Me.MousePointer = vbDefault 
frmProlog.Kill ' destroy frmProlog 
Me.Enabled = True 

If IstDisposition.ListCount > 0 Then 
With IstDisposition 

.Selected(.ListCount - 1) = True 

Set udtClone = mudtFam.ActiveModelClones Jtem(Str(TtenLData(.ListCount - 1))) 
Call udtClone.OpenDoc(mudtWord, IN_DIRECTORY) 
End With 
End If 

UpdateTablControlStates 
End Sub 

Private Sub mnuDispAccept_Click() 

Dim udtClone As Clone 
Dim nodN As Node 
Dim inti As Integer 
Dim strFN As String 

With IstDisposition 
If .SelCount > 0 Then ' make sure something's selected 
For intI = 0 To XistCount - 1 ' for multiselect 
If .Selected(intl) Then 
StrFN = 

ExtractFileName(mudtFam.ActiveModel.ClonesJtem(Str(lstDisposition.ItemData(intI))).FileNa 
me) 

' confirm this operation 

If MsgBox(" Accept variant " & strFN & "?", _ 

vbQuestion + vbYesNo, "Confirm") = vbNo Then 
.Selected(intl) = False 
End If 
End If 

If .Selected(intl) Then 

' get object from active modefs clone collection 

Set udtClone = mudtFam. ActiveModel.Clones.Item(Str( JtemData(intl))) 
' close the document, if it's open 
udtClone, CloseDoc 
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' remove it from the active model's collection 

Call mudtFam,ActiveModeLClones.Remove(Str(.ItemData(intI))) 

' save the checksum in the model 

Call mudtFam.ActiveModel.AddChecksum(udtClone.Checksum) 
' add it to the family clone collection 
Call mudtFam.Clones.AddObj(udtClone) 
' add it to the accepted list box 

Call lstAccepted.AddItem(ExtractFileName(udtClone.FileName)) 
' add key to itemdata 

lstAccepted.ItemData(lstAccepted.ListCount - 1) = udt Clone. index 
' freeze the model 

mudtFam.ActiveModel.FreezeModel 
' update the icon 

Set nodN = treModels.Nodes Jtem(ModelKey(mudtFam.ActiveModel.FileName)) 
nodN image = imSnowflake 

stbS.Panels(pnActiveModelIcon).Picture = imlI.ListImages(nodN,Image).Picture 
Call mudtFam, ActiveModelCloseDoc 
Call mudtFam.ActiveModel.OpenDoc(mudtWord) 
End If 
Next inti 

For intI = .ListCount - 1 To 0 Step -1 
If .Selected(intl) Then 

' remove the entry from the disposition list box 
Call .Removeltem(intl) 
End If 
Next intI 
End If 
End With 

UpdateTabOControlStates 
UpdateTablControlStates 
UpdateTab2ControlStates 

End Sub 

Private Sub mnuDispDefer_Click() 

Dim udtClone As Clone 
Dim intI As Integer 
Dim strFN As String 

With IstDisposition 

If .SelCount > 0 Then ' make sure somethings selected 
For intI = 0 To .ListCount - 1 ' for multiselect 
If .Selected(intl) Then 
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strFN = 

ExtractFileName(mudtFamActiveModel.ClonesJtem(Str(lstDispositionJtemData(m^^^ 
me) 

' confirm this operation 

If MsgBoxC'Defer variant " & strFN & _ 

vbQuestion + vbYesNo, "Confirm") = vbNo Then 

.Selected(intl) = False 
End If 
End If 

If .Selected(intl) Then 

' get object from active model's clone collection 

Set udtClone = mudtFam. ActiveModel.Clones.Item(Str( JtemData(intl))) 
' close the document 
udtClone.CloseDoc 
' delete the clone file 

Kill IN^DIRECTORY & udtClone.FileName 
' remove the clone from the active model's collection 
Call mudtFam.ActiveModel.Clones.Remove(Str(JtemData(intI))) 
End If 
Next inti 

For intI ^ XistCount - 1 To 0 Step -1' for multiselect 
If .Selected(intl) Then 

' remove the entry from the disposition list box 
Call .Removeltem(intl) 
End If 
Next intI 
End If 
End With 



UpdateTab2ControlStates 
End Sub 



Private Sub mnuDispDiscard_Click() 

Dim udtClone As Clone 
Dim intI As Integer 
Dim StrFN As String 



With IstDisposition 

If .SelCount > 0 Then ' make sure somethings selected 
For intI = 0 To XistCount - 1 ' for multiselect 
If .Selected(intl) Then 
StrFN = 

ExtractFileName(mudtFam.ActiveModeLClones.Item(Str(lstDisposition.ItemData(intI))),FileNa 
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' confirm this operation 

If MsgBoxC'Discard variant " & strFN & "?", _ 
vbQuestion + vbYesNo, "Confirm") ^ vbNo Then 
.Selected(intl) = False 

End If 
End If 

If .Selected(intl) Then 

' get object from active model's clone collection 

Set udtClone = mudtFam.ActiveModel.Clones.Item(Str(,ItemData(intI))) 
' save the checksum in the model 

Call mudtFam.ActiveModel.AddChecksum(udtClone.Checksum) 
' close the document 
udtClone.CloseDoc 
' delete the clone file 

Kill IN_DIRECTORY & udtClone.FileName 
' remove the clone from the active model's collection 
Call mudtFam.ActiveModeLClones.Remove(Str(JtemData(intI))) 
End If 
Next inti 

For intI - .ListCount - 1 To 0 Step -T for multiselect 
If .Selected(intl) Then 

' remove the entry from the disposition list box 
Call .Removeltem(intl) 
End If 
Next intI 
End If 
End With 

UpdateTab2ControlStates 
End Sub 

Private Sub mnuDispMakeModel_Click() 

Dim udtClone As Clone 
Dim strNewFN As String 
Dim strKey As String 
Dim strNewKey As String 
Dim udtM As Model 
Dim nodN As Node 
Dim intI As Integer 
Dim StrFN As String 

With IstDisposition 
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If .SelCount > 0 Then ' make sure somethings selected 
For inti - 0 To .ListCount - 1' for multiselect 
If .Selected(intl) Then 
strFN = 

ExtractFileName(mudtFam.ActiveModelClones.Item(Str(lstDispositionJtemData(intI))).FileNa 
me) 

' confirm this operation 

If MsgBox("Create a new model from variant " & strFN & _ 
vbQuestion + vbYesNo, "Confirm") = vbNo Then 
.Selected(intl) = False 
End If 
End If 

If.Selected(intl) Then 

' get object from active model's clone collection 

Set udtClone mudtFam.ActiveModel.Clones.Item(Str( JtemData(intl))) 

' close the document 

udtClone.CloseDoc 

strKey = ModelKey(udtClone.FileName) 
' find the next key for this parent model 
strNewKey = NextModelKey(udtClone.FileName) 
' add the child to the tree 

strNewFN = ModelEmbedKey(udtClone.FileName, strNewKey) 

Set nodN = treModels.Nodes.Add(strKey, tvwChild, strNewKey, strNewFN) 

nodN.Expanded = True 

nodN.sorted ^ True 

nodN.Image = imSun 

' copy the clone to the new model file name 

Call FileCopy(IN_DIRECTORY & udtClone.FileName, IN_DIRECTORY & 

StrNewFN) 

' make a copy of the parent's model file for this child 
Call FileCopy(ModelFileName(IN_DIRECTORY & 
ModelEmbedKey(udtClone.FileName, strKey)), _ 

ModelFileName(IN_DIRECTORY & strNewFN)) 
' add the child's model to the model collection. "Thaw" the child. 
Set udtM - mudtFam.Models. AddExisting(IN_DIRECTORY & strNewFN, _ 

mudtFam.ItemType) 
udtM JsFrozen = False 
' reset the clone index of the child 
udtM.LastClone = 0 
' save it 

udtM.WriteModel 
' tell 'em about it 

Call MsgBox("Variant " & udtClone.FileName & " has been copied to " & 

StrNewFN, 

vblnformation, "Model Created") 
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End If 
Next inti 
End If 
End With 

UpdateTabOControlStates 
UpdateTab2ControlStates 

End Sub 

Private Sub mnuFileNew_Click() 

Dim udtWAPI As New Win32API 
Dim strFN As String 
Dim udtProgram As Program 
Dim udtltemType As ItemType 
Dim udtProximity As Proximity 
Dim blnGeneric As Boolean 
Dim udtini As New IniFile 

' clear out everything 
ClearControls 

' get family values (pun intended) 

frmNew.Show vbModal 

If frmNew.OK = False Then GoTo Cancel 

udtProgram = frmNew.Program 
udtltemType = frmNew.ItemType 
udtProximity = frmNew.Proximity 
blnGeneric = fhnNew. Generic 

With cdlCD 

.InitDir = IN_DIRECTORY 
.FileName = 

.DialogTitle = "Save new family as" 
.Filter = "Model Doc Files (*$R.doc)|*$R.docr 
.DefaultExt = ".doc" 
.Flags = cdlOFNHideReadOnly 
On Error GoTo Cancel 
.ShowSave 
On Error GoTo 0 
StrFN = .FileName 
End With 
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' see if an FN was entered 
IfLen(strFN) = OThen 
Beep 

GoTo Cancel 
End If 

strFN - UCase(strFN) 

' don't allow family to be created if it's not in the "IN" directory 
If InStr(l, StrFN, IN^DIRECTORY, vbTextCompare) Then 

' do nothing 
Else 

Call MsgBoxC'Family must be located in " & IN_DIRECTORY, _ 

vbExclamation, "Error") 
GoTo Cancel 
End If 

' check the extension 

If (InStr(l, StrFN, ".doc", vbTextCompare)) - 0 Then 

Call MsgBox("Invalid file name extension.", vbExclamation, "Error") 

GoTo Cancel 
End If 

Dim varl As Variant 

' embed $R into FN if the user hasn't 

If InStr(l, StrFN, "$R.doc", vbTextCompare) = 0 Then 

varl = InStr(l, strFN, ".doc", vbTextCompare) 

StrFN = Mid(strFN, 1, varl - 1) & "$R.doc" 
End If 

' check for unique FN 
If udtWAPI.FileExists(strFN) Then 
Call MsgBox("File name " & _ 

ExtractFileName(strFN) & " is not unique.", _ 
vbExclamation, "Error") 
GoTo Cancel 
End If 

Dim strShortFN As String 
strShortFN = ExtractFileName(strFN) 

' create a new family object 
Set mudtFam = New Family 
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' set file name, program, and item type 
mudtFam.FileName = strFN 
mudtFam.Program = udtProgram 
mudtFam JtemType = udtltemType 
mudtFam.Proximity ^ udtProximity 
mudtFam. Generic = blnGeneric 
mudtFam JsDirty = True 

' put the family name on the status bar 
stbS.Panels(pnFamilyName) = strShortFN 

' fill in the rest of the status bar 
UpdateFamily Attributes 

' format tab 2 

Call FormatTab2(mudtFam.ItemType) 

' copy correct Word template to new model FN 
Select Case mudtFam JtemType 

Case ptStandardMC 
FileCopy App.path & "\TCASMC.doc", strFN 

Case ptQuantComp 
FileCopy App.path & "\TCAQC.doc", strFN 

Case ptDataSuff 

FileCopy App.path & "\TCADS.doc", strFN 

End Select 

Dim nodN As Node 

' clear out the treeview box 
treModels .Nodes .Clear 

' add the new root 

Set nodN = treModels.Nodes. Add(, , "R", strShortFN, imSun) 
nodN.Expanded = True 
nodN.sorted = True 
nodN.Selected = True 

Call mudtFam.Models.AddNew(strFN, mudtFam JtemType) 
' enable attributes button 
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cmdSet Attributes. Enabled = True 



' force event to set active model 
treModeIs_Click 

Cancel: 

UpdateTabOControlStates 

Exit Sub 
End Sub 

Private Sub mnuFileOpen_Click() 

Dim strFN As String 

' clear out everything 
ClearControls 

With cdlCD 

.InitDir = IN_DIRECTORY 

.FileName = "" 

.CancelError = True 

.DialogTitle = "Open model root" 

.Filter = "Model Doc Files (*$R.doc)|*$R.docr 

.DefaultExt = ".doc" 

.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly 
On Error GoTo Cancel 
.ShowOpen 
On Error GoTo 0 
StrFN = .FileName 
End With 

' exit if there's no file name 
IfLen(strFN) = OThen 

Exit Sub 
End If 

StrFN = UCase(strFN) 

' don't allow family to be opened if it's not in the "IN" directory 
If InStr(l, StrFN, IN_DIRECTORY, vbTextCompare) Then 

' do nothing 
Else 
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Call MsgBoxC'Family must be located in " & IN_DIRECTORY, 

vbExclamation, "Error") 
Exit Sub 
End If 

' find all of the children 

Dim nodN As Node 

Dim strlndex As String 

Dim strT As String 

Dim varll As Variant 

Dim udtWAPI As New Win32API 

Dim strNewFN As String 

Dim colFN As Collection 

' add a wild card to the file name 
varll =InStr(l,strFN, ".") 

StrNewFN - Mid(strFN, 1, varll - 1) & "*" & Mid(strFN, varll, _ 
Len(strFN) - varll + 1) 

' get a collection of file names (*.doc) matching the wild card 
Set colFN = udtWAPLFindAllFiles(strNewFN) 

' create a new family object 
Set mudtFam = New Family 

Dim strMdfFN As String 

' make sure the .mdf file is there. 
StrMdfFN = left(strFN, Len(strFN) - 3) & "mdf 
If udtWAPLFileExists(strMdfFN) = False Then 
Call MsgBox("This family has a " & _ 

"missing mdf file and cannot be loaded. " & 
"File " & StrMdfFN & " is not in the IN directory.", _ 
vbExclamation, "Error") 
Exit Sub 
End If 

' set the file name of the family, read, 
mudtFam.FileName = strFN 
mudtFam.ReadFamily 

Dim udtClone As Clone 

' verify that all variants referenced in the family object are in 
' the IN directory. 
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For Each udtClone In mudtFam.Clones 

' the next Une allows families to be renamed between TCA sessions 
udtClone.FileName = ExtractFamilyName(strFN) & _ 

ExtractFamilyKey(udtClone.FileName) & ".doc" 
If udtWAPLFileExists(IN_DIRECTORY & udtClone.FileName) - False 
Call MsgBoxC'This family has at least " & _ 

"one missing variant file and cannot be loaded. " & _ 
"File " & udtClone-FileName & " is not in the IN directory.", _ 
vbExclamation, "Error") 
Exit Sub 
End If 
Next udtClone 

' put family name on status bar 

stbS.Panels(pnFamilyName) = ExtractFileName(strFN) 
' format tab 2 

Call FormatTab2(mudtFam JtemType) 

' update the accepted Ustbox with leftover clones 
For Each udtClone In mudtFam.Clones 
With IstAccepted 

If udtClone.IsRouted Then 

Call AddItem(udtClone.FileName & ": Routed to TCS") 
Else 

Call .Addltem(udtClone.FileName) 
End If 

.ItemData(.ListCount - 1) = udtClone.index 
End With 
Next udtClone 

' select the first entry, if there is one 
If IstAcceptedXistCount > 0 Then 
IstAccepted.Selected(O) = True 
End If 

' display attribute info on status bar 
UpdateFamily Attributes 

' clear out the dummy list box 
Call IstDummy. Clear 

Dim varFN As Variant 
Dim udtM As Model 
Dim inti As Integer 
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Dim intlcon As Integer 



' dump the file names into a dummy list box which will sort them automatically. 
' the tree control must add them in heirarchical order. 

For Each varFN In colFN 
varll =InStr(l,varFN, ".") 

If IsNumeric(Mid(varFN, varll -1,1))=^ False Then ' it's not a clone 

Call lstDummy,AddItem(varFN) ' add the model 
End If 
Next varFN 

Dim strMdlFN As String 

For inti =^ 0 To IstDummy.ListCount - 1 

varFN = IstDummy.List(intl) 
strlndex = ModelKey(varFN) 
If UCase(strlndex) = "R" Then 

Set nodN = treModels.Nodes.Add(, , strlndex, varFN) 

Set treModels.Selectedltem nodN 
Else 

Set nodN = treModels.Nodes.Add(left(strIndex, Len(strlndex) - 1), _ 
tvwChild, strlndex, varFN) 
End If 

' test to see if corresponding .mdl file exists 
StrMdlFN = left(varFN, Len(varFN) - 3) & "mdl" 
If udtWAPI.FileExists(strMdlFN) - False Then 
Call MsgBox("This family has at least " & _ 

"one missing mdl file and cannot be loaded. " & _ 
"File " & StrMdlFN & " is not in the IN directory.", _ 
vbExclamation, "Error") 
ClearControls 
Exit Sub 
End If 

' add a new model to the collection 

Set udtM = mudtFam.Models,AddExisting(IN_DIRECTORY & varFN, _ 

mudtF am . ItemTyp e) 
If udtM.IsFrozen Then 

nodN.Image = imSnowflake 
Else 

nodN.Image = imSun 
End If 

nodN.Expanded = True 
nodN.sorted = True 
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Next inti 



' enable attributes button 
cmdSetAttributes.Enabled = True 

' force event to set active model 
treModels_Click 

Cancel: 

UpdateTabOControlStates 

Exit Sub 
End Sub 

Private Sub mnuFileImportItem_Click() 

Dim udtini As New IniFile 
Dim strFN As String 

' clear out everything 
ClearControIs 

With cdlCD 

.InitDir = IN_DIRECTORY 
.FileName = "" 
.CancelError = True 
.DialogTitle = "Open locked item" 
.Filter = "Item Doc Files (*.doc)|*.docr 
.DefaultExt = ".doc" 

.Flags - cdlOFNFileMustExist + cdlOFNHideReadOnly 
On Error GoTo Cancel 
.ShowOpen 
On Error GoTo 0 
strFN = .FileName 
End With 
' End If 

' exit if there's no file name 
IfLen(strFN) = OThen 

Exit Sub 
End If 

' don't allow locked item to be opened if it's not in the "IN" directory 
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If InStr(l, strFN, IN_DIRECTORY, vbTextCompare) Then 

' do nothing 
Else 

Call MsgBoxC'Locked item must be located in " & IN_DIRECTORY, _ 

vbExclamation, "Error") 
Exit Sub 
End If 

' set the FN of the ini that accompanies the locked item 

udtlni-FN = IN DIRECTORY & ExtractFileNameNoExt(strFN) & ".ini" 

Dim udtW As New Win32API 

If udtW.FileExists(udtIni.FN) = False Then 

Call MsgBox("Ini file must accompany locked item " & ExtractFileName(strFN) & _ 
vbExclamation, "Error") 

Exit Sub 
End If 

Dim udtProgram As Program 

Dim udtDeliveryMode As DeliveryMode 

Dim udtltemType As ItemType 

Dim strAccNum As String 

' find out about this locked item from the .ini file 
Select Case udtIni.GetProfileString("LockedItemData", "Program") 
Case "GRE" 

udtProgram = prGRE 
Case "GMAT" 

udtProgram = prGMAT 
Case "SAT" 

udtProgram = prS AT 
Case "Not Found" 

Call MsgBox("No Program entry found in ini file " & ExtractFileName(strFN) & _ 

".", vbExclamation, "Error") 
Exit Sub 
End Select 

Select Case udtIni.GetProfileString("LockedItemData", "DeliveryMode") 
Case "CBT" 

udtDeliveryMode = dmCBT 
Case "PPT" 

udtDeliveryMode - dmPPT 
Case "Not Found" 

Call MsgBox("No DeliveryMode entry found in ini file " & ExtractFileName(strFN) & 
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vbExclamation, "Error") 
Exit Sub 
End Select 

Select Case udtIni.GetProfileString("LockedItemData", "ItemType") 
Case "MC Item", "QantDisc", "MC", "Multiple Choice" 

udtltemType = ptStandardMC 
Case "DataSuff , "DS", "Data Sufficiency" 

udtltemType = ptDataSuff 
Case "QC Discrete", "QantComp", "QC", "Quantitative Comparison" 

udtltemType = ptQuantComp 
Case "Not Found" 

Call MsgBox("No ItemType entry found in ini file " & ExtractFileName(strFN) & _ 

".", vbExclamation, "Error") 
Exit Sub 
End Select 

strAccNum = udtIni.GetProfileString("LockedItemData", "LockedAccnum") 
If strAccNum = "Not Found" Then strAccNum = "" 

' initialize locked item object 
Dim udtLI As New Lockedltem 

udtLI.LockedltemFileName = strFN 
udtLI.Wordlnstance = mudtWord 

If udtLI.OpenLockedltemDoc = False Then ' we couldn't figure out what doc and item type it 
was 

Call MsgBox("Locked item file appears to be damaged.", vbExclamation, "Error") 
udtLI.CloseLockedltemDoc 
Exit Sub 
End If 

With cdlCD 
.FileName = "" 

.DialogTitle = "Save new family based on this locked item as" 
.Filter = "Model Doc Files (*$R.doc)|*SR.docr' 
.DefaultExt = ".doc" 
.Flags = cdlOFNHideReadOnly 
On Error GoTo CloseAndCancel 
.ShowSave 
On Error GoTo 0 
strFN = .FileName 
End With 
' End If 
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' see if an FN was entered 
If Len(strFN) = 0 Then 

Beep 

Exit Sub 
End If 

strFN = UCase(strFN) 
' check the extension 

If (InStr(l, StrFN, ".doc", vbTextCompare)) = 0 Then 

Call MsgBox("Invalid file name extension.", vbExclamation, "Error") 

Exit Sub 
End If 

Dim varl As Variant 

' embed $R into FN if the user hasn't 

If InStr(l, StrFN, "$R.doc", vbTextCompare) = 0 Then 

varl = InStr(l, strFN, ".doc", vbTextCompare) 

StrFN = Mid(strFN, 1, varl - 1) & "SR.doc" 
End If 

' check for unique FN 

Dim udtWAPI As New Win32API 

If udtWAPI.FileExists(strFN) Then 
Call MsgBox("File name " & _ 

ExtractFileName(strFN) & " is not unique.", _ 
vbExclamation, "Error") 
Exit Sub 
End If 

' copy the ini file of the locked item to the family name 
Call FileCopy(udtIni.FN, left(strFN, Len(strFN) - 3) & "ini") 

Dim strShortFN As String 
strShortFN = ExtractFileName(strFN) 

' create a new family object 
Set mudtFam = New Family 

' put family name on status bar 
stbS.Panels(pnFamilyName) = strShortFN 

' set file name, program, and item type 
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mudtFam.FileName = strFN 
mudtFam.Program = udtProgram 
mudtFam.ItemType = udtltemType 
mudtFam.AccNum = strAccNum 
mudtFam.IsDirty = Trae 

' format tab 2 

Call FormatTab2(mudtFamJtemType) 

' copy correct Word template to new model FN 
Select Case mudtFam.ItemType 

Case ptStandardMC 
FileCopy App.path & 'MCASMC.doc", strFN 

Case ptQuantComp 

FileCopy App.path & "\TCAQC.doc", strFN 

Case ptDataSuff 
FileCopy App.path & "\TCADS.doc", strFN 

End Select 

Dim nodN As Node 

' clear out the treeview box 
treModels.Nodes.Clear 

' add the new root 

Set nodN - treModels.Nodes.Add(, , "R", strShortFN, imSun) 
nodN.Expanded = True 
nodN.sorted = True 
nodN. Selected = True 

Call mudtFam.Models.AddNew(strFN, mudtFam JtemType) 

mudtFam. Generic False 
mudtFam.Proximity = prNear 

' enable attributes button 
cmdSetAttributes.Enabled = True 

' force event to set attributes 
cmdSet Attributes Click 
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' force event to set active model 
treModels Click 



Select Case udtltemType 
Case ptStandardMC 

Select Case udtDeliveryMode 
Case dmCBT 

Call udtLI.ConvertCBTSMCItem 
Case dmPPT 
Call udtLI.ConvertPPTSMCItem 
End Select 
Case ptDataSuff 

Call udtLLConvertDSItem 
Case ptQuantComp 
Select Case udtDeliveryMode 
Case dmCBT 

Call udtLI.ConvertCBTQCItem 
Case dmPPT 
Call udtLI.ConvertPPTQCItem 
End Select 
End Select 

CloseAndCancel: 

udtLI.CloseLockedltemDoc 
Cancel: 

UpdateTabOControlStates 

Exit Sub 
End Sub 

Private Sub mnuFileExit_Click() 

Call Fonn_Unload(0) 
End 

End Sub 

'Private Sub RetumToTabO() 



Dim intPrevTab As Integer 



10 



15 



20;;; 



2i; 



30 



35 



If sstMainTab.Tab - 0 Then Exit Sub 

intPrevTab = sstMainTab.Tab 

sstMainTab.Tab = 0 

Call sstMainTab_Click(intPrevTab) 

End Sub 

Private Sub mnuFilePrintSetup_Click() 

cdlCD.Flags = cdlPDPrintSetup 

On Error GoTo Cancel 
cdlCD.ShowPrinter 
On Error GoTo 0 

Cancel: 

Exit Sub 

End Sub 

Private Sub ntnuHelpAbout_Click() 

frmAbout.Show vbModal 
End Sub 

Private Sub mnuTreeExtend__Click() 

Dim nodN As Node 
Dim strFN As String 
Dim strNewFN As String 
Dim strKey As String 
Dim strT As String 
Dim strNewKey As String 

If treModels.Selectedltem Is Nothing Then Exit Sub 

Set nodN = treModels.Selectedltem 
StrFN = nodN.Text 

' confirm this operation 

If MsgBox("Make a child model from model " & strFN & . 
vbQuestion + vbYesNo, "Confirm") = vbNo Then 
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Exit Sub 
End If 

strKey = ModelKey(strFN) 
strNewKey = NextModelKey(strFN) 
' add the child to the tree 

strNewFN = ModelEmbedKey(strFN, strNewKey) 

Set nodN = treModels.Nodes .Add(strKey, tvwChild, strNewKey, strNewFN) 
nodN.Expanded = True 
nodN. sorted == True 
nodN.Image ^ imSun 

' deactivate active model to close it before file copies, if the active 
' model is being extended. 

Dim blnReopenModel As Boolean 

blnReopenModel = False 

If strFN = stbS.Panels(pnActiveModelName) Then 

Call mudtFam.ActiveModelCloseDoc 

blnReopenModel = True 
End If 

' make a copy of the parent's word doc for this child 

Call FileCopy(IN_DIRECTORY & strFN, IN_DIRECTORY & strNewFN) 
' make a copy of the parent's model file for this child 

Call FileCopy(IN__DIRECTORY & ModelFileName(strFN), IN_DIRECTORY & 
ModelFileName(strNewFN)) 

' add the child's model to the model collection. "Thaw" the child. 
Dim udtM As Model 

Set udtM = mudtFam.Models.AddExisting(IN_DIRECTORY & strNewFN, _ 

mudtFam.ItemType) 
udtM.IsFrozen = False 

' reset the clone index of the child 
udtM.LastClone = 0 

' reset the checksums 
udtM . Init Checksums 

' save it 
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udtM.WriteModel 



If blnReopenModel Then 

Call mudtFam.ActiveModeLOpenDoc(mudtWord) 
End If 

End Sub 

Private Sub ninuTreeRemove_Click() 

Dim nodN As Node 
Dim strFN As String 
Dim strKey As String 

If trcModels.Selectedltem Is Nothing Then Exit Sub 

Set nodN = treModels.Selectedltem 
StrFN - nodN.Text 

StrKey = ModelKey(strFN) 

Dim collndices As New Collection 

' don't remove if this node or any descendant nodes are frozen 
Dim udtModel As Model 

' check selected node 

If treModels.Selectedltem.index = 1 Then ' it's the root model 

Call MsgBoxC'The root model can't be removed.", vbExclamation, "Error") 
Exit Sub 

End If 

Set udtModel - mudtFam.Models Jtem(treModels.Selectedltem) 
If udtModelJsFrozen Then 

Call MsgBox("Can't remove frozen model", vbExclamation, "Error") 
Exit Sub 
Else 

Call colIndices.Add(treModels.Selectedltem.index) 
End If 

Dim bInDone As Boolean 
blnDone = False 

' check if any of it's descendants are frozen 
Do 
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Set nodN = nodN.Child 
If nodN Is Nothing Then 

' do nothing 
Else 

5 Do 

If mudtFam,Models.Item(nodN.Text).IsFrozen Then 

Call MsgBox("Can't remove model with one or more frozen descendants.", 

vbExclamation, "Error") 
Exit Sub 
10 End If 

Call colIndices.Add(nodN.index) 
Loop Until nodN.index = nodN.LastSibling. index 
End If 

Loop Until nodN Is Nothing 

1 5 ' confirm this operation 

If MsgBox("Remove model " & strFN & " and it's children?", _ 
vbQuestion + vbYesNo, "Confirm") - vbNo Then 
Exit Sub 
'i End If 

2Qi ' close active model document as we're deleting it 

J- mudtFam.ActiveModel.CloseDoc 

J;: mudtFam ActiveModel ^ Nothing 

J j stbS.Panels(pnActiveModelIcon).Picture ^ Nothing 

stbS.Panels(pnActiveModelName) = "" 

2§. ^ Dim varlndex As Variant 

' remove all effected models from the family 

For Each varlndex In collndices 

Call mudtFam.Models.Remove(treModels.Nodes(varIndex)) 
Kill IN_DIRECTORY & left(treModels.Nodes(varIndex), _ 
30 Len(treModels.Nodes(varIndex)) - 3) & "*" 

Next varlndex 

' remove them from the tree control 

Call treModels.Nodes.Remove(colIndices(l)) 

End Sub 

35 Private Sub mnuVariablesAdd_CHck() 
frmVariable.AddEditFlag = aeAdd 
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End Sub 



Private Sub mnuVariablesEdit_Click() 

frmVariable.AddEditFlag = aeEdit 
End Sub 

Private Sub mnuVariablesRemove_Click() 

Dim intind As Integer 

intind = IstVariables.Listlndex ' Get index 

' Make sure list item is selected 
IfintInd<OThen 

Beep 

Exit Sub 
End If 

Dim strVN As String 

strVN = mudtFam.ActiveModel. Variables. Item(Str(lstVariables.ItemData(intInd))). 
* confirm this operation 

If MsgBoxC'Remove variable " & strVN & "?", _ 

vbQuestion + vbYesNo, "Confirm") = vbNo Then 

Exit Sub 
End If 

' Remove the variable jfrom the collection using the key in the hst box 

Call mudtFam,ActiveModeLVariables.Remove(Str(lstVariables.ItemData(intInd))) 

' Remove the variable from the list box 
Call IstVariables.Removeltem(intlnd) 

UpdateTabl ControlStates 

End Sub 

'Empty the variable list box 

Private Sub mnuVariablesRemoveAll__Click() 

' confirm this operation 

If MsgBoxC'Remove all variables?", _ 
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vbQuestion + vbYesNo, "Confirm") = vbNo Then 
Exit Sub 
End If 

'clear the hst box 
1st Variables. Clear 

' empty the collection 
mudtFam.ActiveModel.Variables.Clear 

UpdateTablControlStates 

End Sub 

Private Sub mnuVariablesEnableAll_Click() 

Call SetAllCheckboxes(True) 

UpdateTablControlStates 
End Sub 

Private Sub mnuVariablesDisableAll_CUck() 

Call SetAllCheckboxes(False) 

UpdateTablControlStates 
End Sub 

Private Sub mnuVariablesTest_Click() 

Call TestConstraints(tcTestVariables) 
End Sub 

Private Sub mnuConstraintsAdd_Click() 

• set the add flag for frmConstraints 
frmConstraints.AddEditFlag = aeAdd 
' set the list box 

frmConstraints. ListBox = IstConstraints(mintConstrLBInd) 
' set the model 

firmConstraints.Model = mudtFam.ActiveModel 
' set the constraint type 

frmConstraints.ConstraintType = mintConstrLBInd 
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' crank up the form 
frmConstraints.Show vbModal 

Call UpdateTab 1 ControlStates(mintConstrLBInd) 

End Sub 

Private Sub mnuConstraintsEdit_Click() 

If lstConstraints(mintConstrLBInd).ListIndex >= 0 Then ' Make sure list item is selected 
' set the edit flag for frmConstraints 
frmConstraints. AddEditFlag = aeEdit 
' set the hst box 

1 0 frmConstraints.ListBox = IstConstraints(mintConstrLBInd) 

' set the model 

frmConstraints.Model = mudtFam. ActiveModel 
' set the constraint 

With IstConstraints(mintConstrLBInd) 
frmConstraints.Constraint = _ 
mudtFam.ActiveModel.Constraints.Item(Str(.ItemData(XistIndex))) 
End With 

' set the constraint type 

frmConstraints. ConstraintType = mintConstrLBInd 
' crank up the form 
4" frmConstraints. Show vbModal 

"Xl Else 
1 Beep 
U End If 

2^; Call UpdateTablControlStates(mintConstrLBInd) 

End Sub 

Private Sub mnuConstraintsRemove_Click() 
Dim intind As Integer 

intind = lstConstraints(mintConstrLBInd).ListIndex ' Get index 

30 ' Make sure list item is selected 

IfintInd<OThen 

Beep 

Exit Sub 
End If 
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Dim udtCon As Constraint 
Set udtCon = _ 

mudtFamActiveModel.Constraints.Item(Str(lstConstraints(niintConstrLBInd).IteniData(intInd)) 
) 

' confirm this operation 

If MsgBox("Remove constraint " & udtCon.ConstraintString & "?", _ 

vbQuestion + vbYesNo, "Confirm") = vbNo Then 

Exit Sub 
End If 

' Remove the variable fi-om the collection using the key in the Ust box 
Call 

mudtFam.ActiveModel.Constraints.Remove(Str(lstConstraints(mintConstrLBInd).ItemData(mtI 
nd))) 

' Remove the variable from the Ust box 

Call lstConstraints(mintConstrLBInd).RemoveItem(intInd) 

Call UpdateTab 1 ControlStates(mintConstrLBInd) 

End Sub 

Private Sub mnuConstraintsRemoveAll_Click() 

' confirm this operation 
If MsgBox("Remove all constraints in this Ust box?", _ 

vbQuestion + vbYesNo, "Confirm") = vbNo Then 

Exit Sub 
End If 

'clear the Ust box 

lstConstraints(mintConstrLBInd).Clear 
' empty the collection 

Call mudtFam.ActiveModelConstraints,Clear(mintConstrLBInd) 
Call UpdateTab 1 ControlStates(mintConstrLBInd) 
End Sub 

Private Sub mnuConstraintsEnableAll_Click() 
Call SetAllCheckboxes(True) 



VBSCA-192- 



9 



Call UpdateTab 1 ControlStates(mintConstrLBInd) 
End Sub 

Private Sub mnuConstraintsDisableAll_Click() 
Call SetAllCheckboxes(False) 
5 Call UpdateTab 1 ControlStates(mintConstrLBInd) 

End Sub 

Private Sub mnuConstraintsTest_Click() 

cmdSaveModel_Click ' force a save 

Select Case mintConstrLBInd 
10 Case ctVariation 

: Call TestConstraints(tcTestVariationConstraints) 

J] Case ctDistractor 

51 Call TestConstraints(tcTestDistractorConstramts) 

Jl End Select 

W End Sub 

Private Sub mnuAcceptedProfile_Click() 



Dim udtClone As Clone 
'X Dim inti As Integer 

- j ' set the family 

2ft frmDifficulty.Family - mudtFam 

' set the clone 
With IstAccepted 

For intI = 0 To .ListCount - 1 
If.Selected(intl) Then 
25 Set udtClone = _ 

mudtFam.Clones.Item(Str(JtemData(intI))) 
frmDifficulty. Clone = udtClone 
Exit For 
End If 

30 Next intI 

End With 
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' give frmDifficulty a caption 
fmiDifficulty. Caption = "Profile of variant " & _ 
ExtractFileName(udtClone,FileName) 

' crank up the form 
frmDifficulty.Show vbModal 

If udtClone.IsRouted Then 

IstAccepted.List(intl) = udtClone.FileName & Routed to TCS" 

Else 

IstAccepted.List(intl) = udtClone.FileName 
End If 

End Sub 

Private Sub mnuAcceptedCopy_Click() 
Dim udtClone As Clone 

' this menu option is only active if a variant with a completed profile 
' is currently selected. 
With IstAccepted 

Set udtClone - mudtFam.Clones.Item(Str(.ItemData(.ListIndex))) 

End With 

' copy necessary stuff into a holding area 
Set mudtClone = udtClone 

UpdateTabOControlStates 
End Sub 

' this menu option is only active if a profile has been copied 
Private Sub mnuAcceptedPaste_Click() 

Dim udtClone As Clone 
Dim inti As Integer 

With IstAccepted 

If .SelCount>OThen 
' confirm this operation 

If MsgBox("Paste profile of variant " & mudtClone.FileName & 
" to all selected variants?", _ 
vbQuestion + vbYesNo, "Confirm") = vbNo Then 
Exit Sub 
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End If 

For inti = 0 To .ListCount - 1 
If .Selected(intl) Then 

Set udtClone = mudtFam.Clones.Item(Str( JtemData(intl))) 
' copy necessary stuff from the holding area 
udtClone.Domain mudtClone.Domain 
udtClone.BatchID = mudtClone.BatchID 
udtClone.DeliveryMode = mudtClone.DeliveryMode 
udtClone.Nature = mudtC lone. Nature 
udtClone JsRouted = mudtClone JsRouted 
udtClone.TDEstimate = mudtClone.TDEstimate 
udtClone.IsDifficultyCalculated = mudtClone JsDifficultyCalculated 
If udtClone.IsDifficultyCalculated Then 

udtClone.DiffEst = mudtClone.Difffist.Copy 
End If 

If udtClone.IsRouted Then 

.List(intl) = udtClone.FileName & Routed to TCS" 
Else 

,List(intI) ^ udtClone.FileName 
End If 
End If 
Next intI 
End If 
End With 

End Sub 

' checks/unchecks all checkboxes in a listbox and enable/disable their 
' associated variable or constraint objects 

Private Sub SetAllCheckboxes(ByVal blnBool As Boolean) 
Dim i As Integer 

For i = 0 To (mlstCurrentListBox.ListCount - 1) 

mlstCurrentListBox.Selected(i) = blnBool 
Next i 

Dim udtV As Variable 
Dim udtC As Constraint 

If mlstCurrentListBox.name = "IstVariables" Then 
For Each udtV In mudtFam.ActiveModel Variables 

udtV.Enabled - blnBool 
Next udtV 
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Else 

For i ^ 0 To (mlstCurrentListBox.ListCount - 1) 
Set udtC = 

mudtFamActiveModeLConstramtsJtem(Str(mlstCurrentListBoxJtemData©^^ 
udtCEnabled = blnBool 
Next i 
End If 

End Sub 

Private Sub mwudtModelTest_PrologFmished() 
End Sub 

Private Sub sstMainTab_Click(PreviousTab As Integer) 

Static blnRecursing As Boolean 
Static bytMessage As Byte 

If blnRecursing Then 
Select Case bytMessage 
Case 1 

Call MsgBoxC'Open a model family using the File menu.", _ 
vbExclamation, "Error") 
Case 2 

Call MsgBox("Set the active model by cUcking on a model", _ 
vbExclamation, "Error") 
End Select 
blnRecursing = False 
Exit Sub 
End If 

' error conditions 

If sstMainTab.Tab > 0 Then 

If treModels.Nodes.Count - 0 Then ' family hasn't been set 

bytMessage = 1 

blnRecursing ^ True 

sstMainTab.Tab = PreviousTab ' will trigger recursion 
Exit Sub 
End If 
End If 

If sstMainTab.Tab - 1 Or sstMainTab.Tab = 2 Then 

If mudtFam.ActiveModel Is Nothing Then ' active model has not been set 
bytMessage = 2 
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blnRecursing = True 

sstMainTab.Tab ^ PreviousTab ' will trigger recursion 
Exit Sub 
End If 
End If 

' if we got here, everything's ok! 
If PreviousTab = 2 Then 

txtNum2Generate = 
End If 

If PreviousTab = 1 Then 

If mudtFam.ActiveModellsDirty Then 
KillVariants 'delete any variants on tab 3 

mudtFam.ActiveModel.InitTempChecksums ' initialize temp checksums 
End If 
End If 

' save family 
mudtFam.WritePamily 

* save the active model 

If mudtFam.ActiveModel Is Nothing Then 

' do nothing 
Else 

mudtFam.ActiveModel.WriteModel 
End If 

Select Case sstMainTab.Tab 

CaseO 

' enable new/open 

cmdSetAttributes.Default = True 

mnuFileNew.Enabled = True 

mnuFileOpen.Enabled = True 

mnuFilelmportltem.Enabled = True 

If PreviousTab = 2 Then 

mudtFam.ActiveModelCloseAllCloneDocs 

Call mudtFam.ActiveModel OpenDoc(mudtWord) 

End If 

' if there are no variants, disable the print button 
If IstAccepted.ListCount > 0 Then 
cmdPrintBatch.Enabled = True 
Else 
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cmdPrintBatch.Enabled = False 
End If 

Case 1 

cmdSaveModel.Default = Trae 
' disable new/open 
mnuFileNew.Enabled = False 
mnuFileOpen.Enabled = False 
mnuFilelmportltem.Enabled = False 

' warn if variants exist in IstDisposition and model isn't frozen 
If mudtFam.ActiveModel JsFrozen = False Then 
If IstDisposition.ListCount > 0 Then ' variants exist 

Call MsgBox(" Variants on tab 3 will be deleted if " & _ 
"the model is changed.", vblnformation, "Warning") 
End If 
End If 

If PreviousTab = 0 Then 
mudtFam.CloseAUCloneDocs 
Call mudtFam.ActiveModeLOpenDoc(mudtWord) 

End If 

IfPreviousTab-2Then 

mudtFam.ActiveModel.CloseAUCloneDocs 
CallmudtFam.ActiveModel.OpenDoc(mudtWord) 

End If 

Case 2 

cmdGenerate.Default = True 
' disable new/open 
mnuFileNew.Enabled = False 
mnuFileOpen.Enabled = False 
mnuFilelmportltem.Enabled = False 

' disable the generate button 
cmdGenerate.Enabled = False 

' if there are no variants, disable the print button 
If IstDisposition.ListCount > 0 Then 
cmdPrintVariants. Enabled = True 
Else 

cmdPrintVariants.Enabled = False 
End If 

If PreviousTab = 0 Then 

mudtFam.CloseAUCloneDocs 
End If 
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' display the currently selected document 
With IstDisposition 

If .ListCount > 0 Then ' a valid selection has been made 
Call mudtFam.ActiveModelClones.Item _ 

(Str(JtemData(.ListIndex))).OpenDoc(mudtWord,IN_DIRECTORY) 

Else 

Call mudtFamActiveModel.OpenDoc(mudtWord) 
End If 
End With 

End Select 

End Sub 

' restore full window drag, if necessary 
Private Sub sstMainTab_MouseMove(Button As Integer, _ 
Shift As Integer, X As Single, Y As Single) 

Dim udtW As Win32API 

If mblnRestoreFuUWindowDrag Then 

Set udtW = New Win32API 

udtW.TumOnFuUWindowDrag 

mblnRestoreFuUWindowDrag = False 
End If 

If mudtWord Is Nothing Then Exit Sub 

If sstMainTab.Tab = 1 Then ' do this first, as there will be an active doc 
' on tab 1 

If mudtWord.WordApp.ActiveDocument.Saved = False And _ 
cmdSaveModel.Enabled = False Then 
If Not mudtFam.ActiveModel.IsFrozen Then 
mudtFam.ActiveModeLIsDirty = True 
UpdateTab 1 ControlStates 
End If 
End If 
End If 

End Sub 

Private Sub treModels_Chck() 
Dim nodN As Node 
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If treModels.Selectedltem Is Nothing Then Exit Sub 
Set nodN = treModels.Selectedltem 
' put model icon and name on status bar 

stbS .Panels(pnActiveModelIcon).Picture - imlLListImages(nodN .Image).Picture 
stbS.Panels(pnActiveModelName) = treModels.Selectedltem 

' close doc for existing active model 

If mudtFam ActiveModel Is Nothing Then 

' do nothing 
Else 

mudtFam.ActiveModel.CloseDoc 
End If 

' set the new active model and activate it 

mudtFam.ActiveModel = mudtFamModels Jtem(treModels.Selectedltem) 
Call mudtFam.ActiveModel.OpenDoc(mudtWord) 

' clear out the Variable hst box 
IstVariables. Clear 

' populate the variable Ust box with this model's variables 
Dim udtVar As Variable 

For Each udtVar In mudtFam.ActiveModel.Variables 
With IstVariables 

Call .Addltem(udtVar.ScreenFormat) 
.ItemData(XistCount - 1) udtVar.index 
,Selected(.ListCount - 1) = udtVar. Enabled 
End With 
Next udtVar 

Dim inti 

' clear out the constraint list boxes 
lstConstraints(0).Clear 
lstConstraints( 1 ) , Clear 

' populate the constraint Ust boxes with this model's constraints 
Dim udtCon As Constraint 

For Each udtCon In mudtFam ActiveModelConstraints 
intI = udtCon. ConstraintType 
With IstConstraints(intl) 
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Call .Addltem(udtCon.ConstraintString) 
itemData(.ListCount - 1) = udtCon. index 
.Selected(.ListCount - 1) ^ udtCon.Enabled 
End With 
Next udtCon 

' populate comments form 

frmComments.Comment = mudtFam.ActiveModelComments 

' clear out the clone disposition list box 
IstDisposition.Clear 

' populate the clone list box with this model's clones 
Dim udtClone As Clone 

With IstDisposition 

For Each udtClone In mudtFam.ActiveModel. Clones 
Call .AddItem(ExtractFileName(udtClone.FileName)) 
.ItemData(.ListCount - 1) = udtClone.index 
Next udtClone 
End With 

' save the active model 
mudtFam.ActiveModel. WriteModel 

' adjust menu^utton states depending on active model properties 

UpdateTab 1 ControlStates 

UpdateTab2ControlStates 

' enable extend 

mnuTreeExtend.Enabled = True 
End Sub 

Private Sub treModels_MouseUp(Button As Integer, Shift As Integer 
X As Single, Y As Single) 

If treModels.Nodes.Count > 0 Then 

If Button = vbRightButton Then 
PopupMenu mnuTree 

End If 
End If 

End Sub 
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Private Sub txtNum2Generate_Change() 

' If Val(txtNum2Generate) > 0 Then 
' cmdGenerate. Enabled = Trae 

' Else 

' cmdGenerate. Enabled = False 

' End If 

End Sub 

Private Sub txtVariablize_GotFocus() 

If mudtWord.DocumentsCount = 0 Then 

Beep 
Else 

If mudtWord.SelectionType < wdSelectionNormal Then 

Call MsgBoxC'Nothing is selected.", vbExclamation, "Error") 
Else 

Call AddUndefinedVariables(mudtWord. SelectionText) 
End If 
End If 

End Sub 

' scans a string for undefined variable names and add them to 
' the variable collection and hst box 

Public Sub AddUndefmedVariables(ByVal strNames As String) 

Dim colC As Collection 

Dim strS As Variant 

Dim udtVar As Variable 

Dim colDummy As New Collection 

Set colC = UndefinedNames(strNames) 

' don't do it if the model is frozen! 
If Not mudtFam Is Nothing Then 

If Not mudtFam. ActiveModel Is Nothing Then 
If mudtFam. ActiveModel.IsFrozen Then 

Call MsgBox(" Variables cannot be added to a frozen model" 

vbExclamation, "Error") 
Exit Sub 
End If 
End If 
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End If 



For Each strS In colC 

If MsgBox(" Auto-define variable " & strS & "?", vbQuestion + vbYesNo, 
"New variable detected") = vbYes Then 

Select Case left(strS, 1) 
Case "I" 

Set udtVar = mudtFam.ActiveModeL Variables AddInteger(strS, _ 
True, "1", "100", "1", False, True) 
Case "R" 

Set udtVar = mudtFam.ActiveModeLVariables.AddReal(strS, _ 
True, "1", "100", "1", False, True, True, ".01", True) 
Case "S" 

Set udtVar = mudtFam.ActiveModeLVariables.AddString(strS, _ 
True, True, Chr(164), True, colDummy) 
Case "F" 

Set udtVar = mudtFam. ActiveModel.Variables.AddFraction(strS, 
True, "1", "1", "100", "1", "1", ",1", False, True, False) 
Case "U" 

Set udtVar = mudtFam.ActiveModeLVariables.AddUntyped(strS, 
True, False) 
Case Else ' assume untyped 

Set udtVar = mudtFam. ActiveModel.Variables.AddUntyped(strS, 
True, False) 
End Select 

With IstVariables 

' Add the new variable to the variable Ust box 

Call .Addltem(udtVar.ScreenFormat) 

' Set ItemData to index value of the variable object 

.ItemData(.ListCount - 1) = udtVar.index 

' Check the check box 

.S elect ed(XistCount - 1) = True 
End With 

End If 

Next strS 

' update control states 
IfcolC.Count>OThen 

UpdateTab 1 ControlStates 
End If 
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End Sub 



' accepts a string and parses it for undefined variable names. Returns a 
' collection of the variable names that are unique. 

Public Function UndefmedNames(ByVal strS As String) As Collection 

Dim IngStart As Long 
Dim IngEnd As Long 
Dim strT As String 
Dim bytl As Byte 
Dim byt2 As Byte 
Dim colC As New Collection 
Dim blnDup As Boolean 
Dim varT As Variant 

' parse the variable names out of strS 
For IngStart = 1 To Len(strS) 

bytl = Asc(Mid(strS, IngStart, 1)) 
If bytl >= 65 And bytl <= 90 Then 
For IngEnd = IngStart + 1 To Len(strS) 
byt2 = Asc(Mid(strS, IngEnd, 1)) 
Select Case byt2 

Case 48 To 57, 65 To 90, 97 To 122 

' if if s 0 to 9, A to Z, or a to z, continue searching 
Case Else 

' if it's not, assume end of variable name has been found 
Exit For 
End Select 
Next IngEnd 

StrT - Mid(strS, IngStart, IngEnd - IngStart) 
' throw name away if it's already in colC 
blnDup = False 
For Each varT In colC 

If UCase(varT) = UCase(strT) Then 
blnDup = True 

End If 
Next varT 

' make sure name is not a Prolog function 

If blnDup False Then 

' throw name away if it's already in the main variable collection 
If mudtFam. ActiveModel.Variables.UniqueName(strT) Then 

Call colC.Add(strT) 
End If 

End If 
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IngStart = IngEnd 
End If 
Next IngStart 

Set UndefmedNames = colC 
End Function 

Private Sub TestConstraints(ByVal udtTestType As TestType) 

Dim strVN As String 

Dim blnUnderconstrained As Boolean 

Dim blnTestAborted As Boolean 

If mudtFam.ActiveModelConstraintsOK(udtTestType, mudtProlog, _ 
blnUnderconstrained, blnTestAborted, strVN) Then 

Call MsgBox("Looks good!", vbExclamation, "Test Result") 
Elself blnTestAborted Then 

Call MsgBox('Test aborted!", vbExclamation, "Test Result") 
Elself blnUnderconstrained Then 

Call MsgBoxC Variable " & strVN & " is underconstrained!", _ 
vbExclamation, "Test Result") 

Else 

Call MsgBox("No solutions exist!", vbExclamation, "Test Result") 
End If 

End Sub 

' displays the family attributes on the status bar 

Private Sub UpdateFamilyAttributes() 

Select Case mudtFam.Program 
Case prGRE 

stbS.Panels(pnProgramName) 
Case prGMAT 

stbS.Panels(pnProgramName) 
Case prSAT 

stbS.Panels(pnProgramName) 
End Select 

Select Case mudtFam JtemType 
Case ptStandardMC 

stbS.Panels(pnltemType) - "SMC" 
Case ptQuantComp 



= "GRE" 
= "GMAT' 
= "SAT" 
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stbS.Panels(pnltemType) = "QC" 
Case ptDataSuff 

stbS.Panels(pnItemType) = "DS" 
End Select 

If mudtFam. Generic Then 

stbS.Panels(pnGeneric) = "Generic" 
Else 

stbS.Panels(pnGeneric) = "Non generic" 
End If 

Select Case mudtFam.Proximity 
Case prNear 

stbS.Panels(pnProximity) = "Near" 
Case prMedium 

stbS.Panels(pnProximity) = "Medium" 
Case prFar 

stbS.Panels(pnProximity) = "Far" 
End Select 

End Sub 

' returns the model file name given the doc file name 

Private Function ModelFileName(ByVal strDocFN As String) As String 

ModelFileName - left(strDocFN, Len(strDocFN) - 4) & ".mdl" 
End Function 

' extracts the key from a model file name 

Private Function ModelKey(ByVal strFN As String) As String 

Dim varll As Variant 
Dim varI2 As Variant 
Dim inti As Integer 
Dim strS As String 

varll -InStr(l, StrFN, "$") 
varI2 = InStr(varIl, strFN, ".") 

' strip off numbers or spaces to the left of the "." 
intI varI2 
Do While intl> varll 
intI = intI - 1 
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strS = Mid(strFN, inti, 1) 

If Asc(strS) >= 65 And Asc(strS) <= 91 Then ' it's A to Z 

varI2 - inti + 1 

Exit Do 
End If 
Loop 

ModelKey - Mid(strFN, varll + 1, varI2 - varll - 1) 
End Function 

' embeds a new key into a model file name 

Private Function ModelEmbedKey(ByVal strFN As String, ByVal strNewKey As String) 
As String 

Dim varll As Variant 
Dim varI2 As Variant 
Dim intI As Integer 
Dim strS As String 

varll =InStr(U StrFN, "$") 
varI2 = InStr(varIl, strFN, 

' strip off numbers or spaces to the left of the 
intI = varI2 
Do While intl> varll 
intI = intI - 1 

strS = Mid(strFN, intI, 1) 

If Asc(strS) >= 65 And Asc(strS) <= 91 Then ' it's A to Z 

varI2 = intI + 1 

Exit Do 
End If 
Loop 

ModelEmbedKey = left(strFN, varll) & strNewKey & right(strFN, 4) 
End Function 

' returns the key of the next child for this model 

Private Function NextModelKey(strFN As String) As String 

Dim nodN As Node 
Dim strNewFN As String 
Dim strlndex As String 
Dim strT As String 
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strlndex = ModelKey(strFN) 



Dim inti As Integer 

' when the key can't be found in the Nodes collection, an error 
' is raised. When the error is raised, the first available letter 
' of the alphabet has been found. 

On Error GoTo Found 

For intI = 65 To 90 ' A thru Z 
strT = Chr(intl) 

Set nodN = treModels.Nodes.Item(strIndex & strT) 
Next intI 

On Error GoTo 0 

Call MsgBox("Can't add another child model to this parent", _ 

vbExclamation, "Error") 
Exit Function 

Found: 

NextModelKey strlndex & strT 
Exit Function 

End Function 

' resets controls and variables when a new family is opened. 
Private Sub ClearControls() 

If mudtFam Is Nothing Then 

' do nothing 
Else 

mudtFam.WriteFamily 

If mudtFam.ActiveModel Is Nothing Then 

' do nothing 
Else 

mudtFam. ActiveModel.WriteModel 
End If 
End If 

mudtWord.CloseAllDocs 
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Set mudtFam = Nothing 
Set mudtClone = Nothing 

treModels, Nodes. Clear 
IstVariables.Clear 
IstDisposition.Clear 
IstAccepted.Clear 
stbS.Panels(pnProgramName) = 
stbS.Panels(pnFamilyName) = 
stbS.PaneIs(pnItemType) = 
stbS.Panels(pnGeneric) - 
stbS.Panels(pnProximity) - 

stbS.Panels(pnActiveModelIcon). Picture ^ Nothing 
stbS.Panels(pnActiveModelName) = 
frmComments. Comment ^ 
mnuAcceptedCopy.Enabled = False 
mnuAcceptedPaste.Enabled = False 

End Sub 

' used to reformat tab 2 as QC and DS don't need a distractor hstbox 
Private Sub FormatTab2(ByVal udtltemType As ItemType) 

Select Case udtltemType 
Case ptStandardMC 

' turn on the distractor hst box 

IblDistractor. Visible = True 

IstConstraints(l). Visible = True 

cmdConstraintAdd(l). Visible = True 

cmdConstraintEdit(l),Visible = True 

cmdConstraintRemove(l).Visible = True 

cmdConstraintTest(l).Visible = True 
Case ptQuantComp 

' turn off the distractor Ust box 

IblDistractor. Visible = False 

IstConstraints(l). Visible = False 

cmdConstraintAdd(l).Visible = False 

cmdConstraintEdit(l). Visible = False 

cmdConstraintRemove(l). Visible = False 

cmdConstraintTest(l).Visible = False 
Case ptDataSuff 

' turn off the distractor list box 

IblDistractor. Visible = False 

IstConstraints(l). Visible = False 

cmdConstraintAdd(l). Visible = False 
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cmdConstraintEdit(l),Visible = False 
cmdConstraintRemove(l). Visible ^ False 
cmdConstraintTest(l).Visible = False 
End Select 

End Sub 

' this method gets rid of all variants in the IstDisposition listbox, 
' deletes them from disk, and removes them from the active model. 

Private Sub KillVariants() 

Dim udtClone As Clone 
Dim inti As Integer 

With IstDisposition 

For intI = 0 To .ListCount - 1 

' get object from active model's clone collection 

Set udtClone = mudtFam.ActiveModeLClones.Item(Str(.ItemData(intI))) 
' close the document 
udtClone.CloseDoc 
' delete the clone file 

Kill IN_DIRECTORY & udtClone.FileName 
' remove the clone from the active model's collection 
Call mudtFam.ActiveModel.Clones.Remove(Str(JtemData(intI))) 
Next intI 

For intI - .ListCount - 1 To 0 Step -1 

' remove the entry from the disposition Ust box 

Call .Removeltem(intl) 
Next intI 
End With 

End Sub 

Private Sub UpdateTabOControlStatesQ 

' update model tree menu states 
With treModels 

If .Nodes.Count>OThen 
mnuTreeExtend.Enabled = True 
mnuTreeRemove. Enabled = True 
cmdTreeExtend.Enabled = True 
cmdTreeRemove. Enabled = True 
Else 

mnuTreeExtend.Enabled = False 
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mnuTreeRemove.Enabled = False 
cmdTreeExtend.Enabled = False 
cmdTreeRemove.Enabled = False 
End If 
End With 

' update accepted list box menu states 
With IstAccepted 

If .ListCount>OThen 

cmdPrintBatch.Enabled = True 

If .SelCount = 1 Then ' 1 item is selected 

mnuAcceptedProfile.Enabled = True 

mnuAcceptedCopy.Enabled = True 

cmdAcceptedEdit.Enabled = True 

cmdAcceptedCopy.Enabled = True 
Elself .SelCount > 1 Then ' more than one is selected 

mnuAcceptedProfile.Enabled = False 

mnuAcceptedCopy.Enabled = False 

cmdAcceptedEdit.Enabled ^ False 

cmdAcceptedCopy.Enabled = False 
End If 

Else ' nothings in the Hst box 

cmdPrintBatch.Enabled = False 

mnuAcceptedProfile.Enabled = False 

mnuAcceptedCopy.Enabled = False 

mnuAcceptedPaste.Enabled = False 

cmdAcceptedEdit.Enabled = False 

cmdAcceptedCopy.Enabled = False 

cmdAcceptedPaste.Enabled = False 
End If 
End With 

If mudtClone Is Nothing Then ' nothing to paste 

mnuAcceptedPaste.Enabled = False 

cmdAcceptedPaste.Enabled = False 
Elself IstAccepted. SelCount > 0 Then ' one or more are selected 

mnuAcceptedPaste.Enabled = True 

cmdAcceptedPaste.Enabled = True 
Else ' none are selected 

mnuAcceptedPaste.Enabled = False 

cmdAcceptedPaste.Enabled = False 
End If 

If mudtFam Is Nothing Then 
cmdDone.Enabled = False 
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Else 

cmdDone.Enabled = True 
End If 

End Sub 

5 Private Sub UpdateTablControlStates(Optional ByVal intlndex As Integer - 0) 

Dim strCaption As String 

If mudtFam.ActiveModel.IsFrozen Then 

StrCaption = "Browse" 
Else 

10 StrCaption - "Edit" 

End If 

mnuVariablesEdit.Caption = strCaption 
cmdVariableEdit,Caption = strCaption 
mnuConstraintsEdlt . Captiou = strCaption 
cmdConstraintEdit(O). Caption = strCaption 
0" cmdConstraintEdit(l). Caption = strCaption 

4 = ' update variable list box menu states 

jl If mudtFam.ActiveModel.IsFrozen Then 

4^ mnuVariablesAdd.Enabled = False 

2^^ mnuVariablesEdit.Enabled = True 

mnuVariablesEnableAll.Enabled = False 
mnuVariablesDisableAll.Enabled = False 
% mnuVariablesRemove. Enabled = False 

r;; mnuVariablesRemoveAll.Enabled = False 

2&i cmdVariableAdd.Enabled = False 

5= cmdVariableEdit.Enabled = True 

cmdVariableRemove.Enabled = False 
Elself IstVariables.ListCount > 0 Then 
mnuVariablesAdd.Enabled ^ True 
30 mnuVariablesEdit.Enabled = True 

mnuVariablesEnableAll.Enabled True 
mnuVariablesDisableAll.Enabled = True 
mnuVariablesRemove.Enabled ^ True 
mnuVariablesRemoveAlLEnabled = True 
35 cmdVariableAdd.Enabled = True 

cmdVariableEdit.Enabled True 
cmdVariableRemove.Enabled = True 
Else 

mnuVariablesAdd.Enabled = True 
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mnuVariablesEdit.Enabled = False 
mnuVariablesEnableAll.Enabled = False 
mnuVariablesDisableAU. Enabled = False 
mnuVariablesRemove.Enabled = False 
mnuVariablesRemoveAU.Enabled = False 
cmdVariableAdd.Enabled = True 
cmdVariableEdit. Enabled = False 
cmdVariableRemove.Enabled = False 
End If 

' isfrozen should not effect state of test option 
If IstVariables.ListCount > 0 Then 

mnuVariablesTest.Enabled = True 

cmdVariableTest.Enabled = True 
Else 

mnuVariablesTest.Enabled = False 
cmdVariableTest.Enabled = False 
End If 

' update constraints list box menu states 

If mudtFam. ActiveModel JsFrozen Then 
mnuConstraintsAdd.Enabled = False 
mnuConstraintsEdit.Enabled = True 
mnuConstraintsEnableAlLEnabled - False 
mnuConstraintsDisableAU. Enabled = False 
mnuConstraintsRemove.Enabled = False 
mnuConstraintsRemoveAlLEnabled = False 
cmdConstraintAdd(0).Enabled = False 
cmdConstraintAdd(l).Enabled = False 
cmdConstraintEdit(O). Enabled = True 
cmdConstraintEdit(l). Enabled ^ True 
cmdConstraintRemove(O). Enabled = False 
cmdConstraintRemove(l).Enabled = False 

Elself lstConstraints(intIndex).ListCount > 0 Then 
mnuConstraintsAdd.Enabled = True 
mnuConstraintsEdit.Enabled = True 
mnuConstraintsEnableAlLEnabled = True 
mnuConstraintsDisableAll.Enabled ^ True 
mnuConstraintsRemove.Enabled True 
mnuConstraintsRemoveAlLEnabled = True 
cmdConstraintAdd(intlndex). Enabled = True 
cmdConstraintEdit(intlndex). Enabled = True 
cmdConstraintRemove(intlndex). Enabled ^ True 

Else 

mnuConstraintsAdd.Enabled = True 
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mnuConstraintsEdit.Enabled = False 
mnuConstraintsEnableAllEnabled = False 
mnuConstraintsDisableAlLEnabled = False 
mnuConstraintsRemove.Enabled = False 
mnuConstraintsRemoveAlLEnabled = False 
cmdConstraintAdd(intIndex).Enabled = True 
cmdConstraintEdit(intIndex).Enabled = False 
cmdConstraintRemove(intIndex).Enabled = False 
End If 

' isfrozen should not effect state of test option 
If lstConstraints(intIndex).ListCount > 0 Then 
mnuConstraintsTest.Enabled = True 
cmdConstraintTest(intlndex). Enabled = True 
Else 

mnuConstraintsTest.Enabled = False 
cmdConstraintTest(intIndex).Enabled = False 
End If 

' flip the index 

If intlndex = 0 Then 

intlndex = 1 
Else 

intlndex = 0 
End If 

' update button states for the other constraint list box 
If mudtFam.ActiveModel.IsFrozen = False Then 
If lstConstraints(intIndex).ListCount > 0 Then 
cmdConstraintAdd(intIndex).Enabled = True 
cmdConstraintEdit(intIndex).Enabled = True 
cmdConstraintRemove(intlndex). Enabled = True 
Else 

cmdConstraintAdd(intIndex),Enabled = True 
cmdConstraintEdit(intIndex).Enabled = False 
cmdConstraintRemove(intIndex).Enabled = False 
End If 
End If 

' isfrozen should not effect state of test option 
If lstConstraints(intIndex).ListCount > 0 Then 

cmdConstraintTest(intlndex). Enabled = True 
Else 

cmdConstraintTest(intlndex). Enabled = False 
End If 
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' update import button 
If mudtFam. ActiveModel.IsFrozen Then 
cmdImportConstraints.Enabled = False 
Else 

5 cmdImportConstraints.Enabled = True 

End If 

' if model frozen, disable save 
If mudtFam. ActiveModel.IsFrozen Then 
cmdSaveModel. Enabled = False 
10 Else 

If mudtFam.ActiveModel JsDirty Then 

cmdSaveModel.Enabled = True 
Else 

cmdSaveModelEnabled = False 
15 End If 

End If 

End Sub 

m Private Sub UpdateTab2ControlStates() 

i;; ' update disposition list box menu states 

2^] If IstDisposition.ListCount > 0 And cmdGenerate. Caption = "Generate" Then 

mnuDispAccept.Enabled = True 
mnuDispDefsr.Enabled = True 
1 mnuDispDiscard.Enabled = True 

mnuDispMakeModel.Enabled = True 
cmdPrintVariants. Enabled = True 
cmdPrintVariants .Enabled = True 
cmdDispAccept.Enabled = True 
cmdDispDefer.Enabled = True 
cmdDispDiscard.Enabled = True 
30 cmdDispMakeModel.Enabled = True 

Else 

mnuDispAccept.Enabled = False 

mnuDispDefer.Enabled = False 

nmuDispDiscard.Enabled = False 
3 5 mnuDispMakeModel.Enabled = False 

cmdPrintVariants.Enabled = False 

cmdPrintVariants.Enabled = False 

cmdDispAccept.Enabled False 

cmdDispDefer.Enabled = False 
40 cmdDispDiscard.Enabled = False 

cmdDispMakeModel.Enabled = False 
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End If 
End Sub 
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' Variable.frm 
VERSION 5.00 

Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.0CX" 
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.0CX" 
Begin VB.Fomi frmVariable 
BorderStyle = 4 'Fixed ToolWindow 
Caption = "Create or Change Variable" 
ClientHeight = 4230 
ClientLeft = 45 
ClientTop =285 
ClientWidth = 6525 
LinkTopic = "Forml" 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 4230 
ScaleWidth = 6525 
ShowInTaskbar = 0 'False 
StartUpPosition = 1 'CenterOwner 
Begin VB.ComboBox cboVarType 

Height = 315 

ItemData = "Variable.frx":0000 

Left = 2040 

List = "Variable.frx":0013 

Style = 2 'Dropdown List 

Tablndex = 1 

ToolTipText = "Select the variable type." 
Top = 360 

Width = 1695 
End 

Begin VB.CheckBox chkChecksum 
Caption = "Add to checksum" 
Height = 375 
Left = 240 
Tablndex = 2 

ToolTipText = "Check this box to add this variable to the checksum calcuation." 
Top = 840 

Value = 1 'Checked 
Width = 1815 
End 

Begin MSComDlg.CommonDialog cdlCD 
Left = 5280 
Top = 2520 

_ExtentX = 847 
ExtentY = 847 
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Version = 393216 
End 

Begin VB.CommandButton cmdVarExport 
Caption = "Export Strings" 
Height = 495 
Left = 5160 
Tablndex = 7 

ToolTipText = "Click here to export a set of strings." 
Top = 1920 

Width = 1215 
End 

Begin VB.CommandButton cmdVarlmport 
Caption = "Import Strings" 
Height = 495 
Left = 5160 
Tablndex = 6 

ToolTipText = "Click here to import a set of strings." 
Top = 1320 

Width = 1215 
End 

Begin VB.TextBox txtVariableName 
Height =315 
Left = 240 
Tablndex = 0 

ToolTipText = "Enter the variable name here." 
Top = 360 

Width = 1695 
End 

Begin VB.CommandButton cmdVarCancel 
Caption = "Cancel" 
Height = 495 
Left = 5160 
Tablndex = 5 

ToolTipText = "Click here to return without saving changi 
Top = 720 

Width = 1215 
End 

Begin VB.CommandButton cmdVarOK 
Caption = "OK" 
Default = -1 'True 
Height = 495 
Left = 5160 

Tablndex = 4 

ToolTipText = "Click here to save changes and return." 
Top = 120 
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Width = 1215 
End 

Begin ComctlLib.ListView IvwTemp 
Height = 375 
5 Left - 5280 

Tablndex = 43 
Top = 3120 

Visible = 0 'False 
Width = 495 
10 _ExtentX = 873 

_ExtentY = 661 
View = 3 
Arrange = 2 
LabelEdit = 1 
15 MultiSelect = -1 'True 

Label Wrap = -1 'True 
HideS election = -1 'True 
_Version = 327682 
ForeColor = -2147483640 
M BackColor = -2147483643 

J- BorderStyle = 1 

y=] Appearance - 1 

4° Numltems = 0 

J'^ End 
2|- Begin ComctlLib.ListView IvwDummy 
Height = 375 
Left = 5280 
Tablndex = 44 
Top = 3600 

3b:^ Visible = 0 'False 

%[ Width = 495 

f{ ^xtentX = 873 

ExtentY = 661 
View = 3 
35 Arrange = 2 

LabelEdit - 1 
MultiSelect = -1 'True 
LabelWrap = -1 'True 
HideS election = -1 'True 
40 _Version = 327682 

ForeColor = -2147483640 
BackColor = -2147483643 
BorderStyle = 1 
Appearance = 1 
45 Numltems = 0 
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End 

Begin VB. Frame fraString 
BorderStyle = 0 'None 
Height = 2895 
5 Left = 240 

Tablndex = 9 
Top = 1200 

Width =4815 
Begin ComctlLib.ListView IvwStrings 
10 Height = 1815 

Left = 0 
Tablndex = 42 
Top = 720 

Width = 3975 
15 _ExtentX = 7011 

_ExtentY = 3201 
View = 3 

Arrange = 2 
LabelEdit = 1 
M MultiSelect = -1 'True 

f: LabelWrap = -1 True 

m HideSelection = -1 'True 

]; _Version = 327682 

ForeColor = -2147483640 
2l« BackColor = -2147483643 

^■^ BorderStyle = 1 

i Appearance = 1 

■=.: Numltems = 0 

i: End 

3b' Begin VB.CheckBox chklndexed 

JI^ Caption = "Indexed" 

Height = 375 
Left = 0 
Tablndex = 41 
35 ToolTipText = "Check this box for indexed strings." 

Top = 0 

Width = 1215 
End 

Begin VB.CommandButton cmdRemove 
40 Caption = "Remove" 

Height = 255 
Left = 2640 

Tablndex = 40 

ToolTipText = "Click here to remove a set of indexed values." 
45 Top = 2520 
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Width = 1335 
End 

Begin VB.CommandButton cmdEdit 
Caption = "Edit" 
5 Height = 255 

Left = 1320 
Tablndex = 39 

ToolTipText = "Click here to edit a set of indexed values." 
Top = 2520 

10 Width = 1335 

End 

Begin VB.CommandButton cmdAdd 
Caption = "Add" 
Height = 255 
15 Left = 0 

Tablndex = 38 

ToolTipText = "Click here to add a new set of indexed values.' 
Top = 2520 

Width = 1335 
2ff! End 
3'; Begin VB.Label IblStringVals 

yi Caption = "String values" 

J; Height = 255 

41 Left = 0 

2i- Tablndex = 37 

41 Top = 480 

Width = 1695 
m End 
'ii End 
30;^ Begin VB.Frame fraUntyped 
BorderStyle = 0 'None 
Height = 2895 
Left = 240 
Tablndex = 35 
35 Top = 1200 

Width =4815 
Begin VB.TextBox txtUntyped 
Height = 2295 
Left = 240 
40 Locked = -1 'True 

MultiLine = -1 'True 
Tablndex = 36 
ToolTipText = "Interesting, no?" 
Top =360 
45 Width = 4335 
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10 



15 



2(i' 



2Sf" 



3a: 



35 



40 



End 
End 

Begin VB .Frame fralndependent 
BorderStyle = 0 'None 
Caption = "Framel" 
Height = 2895 
Left = 240 
Tablndex = 10 
Top = 1200 

Width =4815 
Begin VB.CheckBox chklslndependent 

Caption = "Independent" 

Height = 375 

Left = 0 

Tablndex = 11 

ToolTipText = "Check this box if the value of this variable is not dependent." 

Top = 0 

Value = 1 'Checked 
Width = 1575 
End 

Begin VB .Frame fraRealFormat 
BorderStyle = 0 'None 
Height = 1095 
Left = 0 
Tablndex = 26 
Top = 1680 

Width =4815 
Begin VB.CheckBox chkOnGrid 



"Value must be multiple of precision" 
= 375 
= 1800 
= 45 
= 120 
= 2895 



45 



Caption 
Height 
Left 

Tablndex 
Top 
Width 
End 

Begin VB.ComboBox cboPrecision 

Height = 315 

ItemData = "Variable.frx":0041 

Left = 120 

List = "Variable.frx":0060 

Style = 2 'Dropdown List 

Tablndex = 34 

Top = 360 

Width = 1455 
End 
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Begin VB.CheckBox chkTrailingZeros 

Caption = "Display trailing zeros" 

Height = 375 

Left = 1800 

Tablndex = 28 

Top = 480 

Width = 1935 
End 

Begin VB. Label LblDecinnals 
Caption = "Precision" 
Height = 255 
Left = 480 
Tablndex = 29 
Top = 120 

Width = 1095 
End 
End 

Begin VB. Frame fi-aFractionFormat 
BorderStyle = 0 'None 
Caption = "Framel " 
Height = 1215 
Left = -120 

Tablndex = 32 
Top = 1560 

Width = 5055 
Begin VB.CheckBox chkMixedNumbers 

Caption = "Mixed numbers" 

Height = 375 

Left = 1560 

Tablndex = 33 

ToolTipText = "Check this box if you wish improper fi-actions to be converted into 
mixed numbers." 

Top = 240 

Width = 1695 
End 
End 

Begin VB. Frame fralntRealRange 
BorderStyle = 0 'None 
Height = 1335 
Left = 0 
Tablndex = 22 
Top =360 
Width =4815 
Begin VB.TextBox txtBy 
Height = 315 
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Left = 3240 

Tablndex = 25 
Text = "1" 

ToolTipText = "Enter the increment here. Variables and expressions may be used." 
Top = 600 

Width = 1455 
End 

Begin VB.TextBox txtTo 
Height =315 
Left = 1680 
Tablndex = 24 
Text = "100" 

ToolTipText = "Enter the value in the range here. Variables and expressions may be 

used." 

Top = 600 

Width = 1455 
End 

Begin VB.TextBox txtFrom 
Height = 315 
Left = 120 
Tablndex = 23 
Text = "1" 

ToolTipText = "Enter the lowest value in the range here. Vanables and expressions 
maybe used." 

Top = 600 

Width = 1455 
End 

Begin VB. Label IblBy 

Caption = "By" 

Height = 255 

Index = 0 

Left = 3840 

Tablndex = 31 

Top = 360 

Width = 495 
End 

Begin VB. Label IblTo 

Caption = "To" 

Height = 255 

Index = 0 

Left = 2280 

Tablndex = 30 

Top = 360 

Width = 615 
End 
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Begin VB.Label IblFrom 

Caption = "From" 

Height = 255 

Index = 0 

Left = 720 

Tablndex = 27 

Top = 360 

Width = 975 
End 
End 

Begin VB. Frame fraFractionRange 
BorderStyle = 0 'None 
Height = 1455 
Left = 0 
Tablndex = 12 
Top = 360 

Width =4815 
Begin VB.TextBox txtByNum 

Height = 315 

Left = 3240 

Tablndex = 18 

Text = "1" 

ToolTipText = "Enter the numerator of the increment here." 
Top = 360 

Width = 1455 
End 

Begin VB.TextBox txtToNum 
Height = 315 
Left = 1680 
Tablndex = 17 
Text = "100" 

ToolTipText = "Enter the numerator of the highest value in the range here. 
Top = 360 

Width = 1455 
End 

Begin VB.TextBox toctFromNum 
Height = 315 
Left = 120 

Tablndex = 16 
Text = "1" 

ToolTipText = "Enter the numerator of the lowest value of the range here. 
Top = 360 

Width = 1455 
End 

Begin VB.TextBox txtFromDen 
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Height = 315 
Left = 120 
Tablndex = 15 
Text = "1" 

ToolTipText = "Enter the denominator of the lowest value in the range here.' 
Top = 840 

Width = 1455 
End 

Begin VB.TextBox txtToDen 
Height = 315 
Left = 1680 
Tablndex = 14 
Text = "1" 

ToolTipText = "Enter the denominator of the highest value in the range here 
Top = 840 

Width = 1455 
End 

Begin VB.TextBox txtByDen 
Height = 315 
Left = 3240 
Tablndex = 13 
Text = "1" 

ToolTipText = "Enter the denominator of the increment here." 
Top = 840 

Width = 1455 
End 

Begin VB.Label IblBy 

Caption = "By" 

Height =255 

Index = 1 

Left = 3840 

Tablndex = 21 

Top = 120 

Width = 255 
End 

Begin VB.Label IblTo 

Caption = "To" 

Height = 255 

Index = 1 

Left = 2280 

Tablndex = 20 

Top = 120 

Width = 375 
End 

Begin VB.Label IblFrom 
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Width 








End 








Begin VB.Line 
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10 


BorderWidth 
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End 








Begin VB.Line 


T * 1 
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BorderWidth 
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Index 




1 


2m 
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-.^ : 
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Y2 
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End 






2t: 


Begin VB.Line 


T ' 1 

Linel 




BorderWidth 


= 3 




Index 




= 2 




XI 




3240 




X2 




4680 




Yl 




750 




Y2 




750 



O End 
End 
End 

35 Begin VB.Label IblVarType 

Caption = "Type" 

Height =255 

Left = 2040 

Tablndex = 8 
40 Top = 120 

Width = 1095 
End 

Begin VB.Label IblVarName 
Caption = "Variable Name" 
45 Height = 255 
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Left = 240 
Tablndex = 3 
J Top = 120 

Width = 1095 
5 End 

Begin VB.Menu mnuString 
Caption = "String" 
y Visible = 0 'False 

Begin VB.Menu mnuStringAdd 
10 Caption = "Add" 

End 

Begin VB.Menu ninuStringEdit 
Caption = "Edit" 

• End 

1 5 Begin VB .Menu mnuStringRemove 

Caption = "Remove" 
End 
End 

• End 

2(|1 Attribute VB_Nanie = "jfrmVariable" 
3 j Attribute VB_GlobalNameSpace = False 
y 1 Attribute VB_Creatable = False 

Attribute VB_PredeclaredId = True 

• "^^ Attribute VB^xposed = False 
2S2 Option Explicit 

= : Private mudtVar As Variable 
J'i Private mudtVarInt As Varlnteger 
^ :!1 Private mudtVarReal As VarReal 

■Z. Private mudtVarFraction As VarFraction 
30;: Private mudtVarString As VarString 

Private mudtVarUntyped As VarUntyped 

' to see if the variable type has changed 
Private mudtType As VariableType 
Private mudtOldType As VariableType 

35 ' needed for string list box 

Private HibytAddEditFlag As Byte 

' needed for listbox update 
Private mlstListBox As ListBox 

'current active model 

• 40 Private mudtModel As Model 
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Public Property Let AddEditFlag(ByVal bytNewValue As Byte) 

mbytAddEditFlag = bytNewValue 
End Property 

Public Property Get AddEditFlagQ As Byte 

AddEditFlag = mbytAddEditFlag 
End Property 

Public Property Let Variable(ByVal udtNewValue As Variable) 

Set mudtVar = udtNewValue 
End Property 

Public Property Let ListBox(ByVal IstNewValue As ListBox) 

Set mlstListBox = IstNewValue 
End Property 

Public Property Let Model(ByVal udtNewValue As Model) 

Set mudtModel = udtNewValue 
End Property 

Private Sub chkIndexed_Click() 

Call CopyListView(lvwStrings, IvwTemp) 
Call CopyListView(lvwDummy, IvwStrings) 
Call CopyListView(lvwTemp, IvwDummy) 

End Sub 

Private Sub CopyListView(ByVal Ivwl As ListView, lvw2 As ListView) 

Dim inti As Integer 
Dim intI2 As Integer 
Dim Isiltem As Listltem 

' copy visible listview into temp listview 
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Ivw2 .Listltems .Clear 
lvw2.ColumnHeaders.Clear 

For inti = 1 To IvwLColumnHeaders.Count 

Call lvw2.ColumnHeaders.Add(, , IvwLColumnHeaders(intl)) 
Next intI 

For intI = 1 To IvwLListltems.Count 

Set Isiltem = lvw2.ListItems.Add(, , lvwl.ListItems.Item(intI),Text) 

For intI2 = 1 To Ivwl.ColumnHeaders.Count - 1 

Isiltem. SubItems(intI2) - Ivwl. Listltems. Item(intI).SubItems(intI2) 

Next intI2 
Next intI 

End Sub 

Private Sub cmdAdd_Click() 
Call mnuStringAdd_Click 
End Sub 

Private Sub cmdEdit_Click() 
Call mnuStringEdit_Click 
End Sub 

Private Sub cmdRemove_Click() 
Call mnuStringRemove_Click 
End Sub 

Private Sub Form_Load() 

Dim udtWAPI As New Win32API 
' enable full row select 

Call udtWAPLEnableListViewFullRowSelect(lvwStrings) 

' load up explanation of untyped variables 
txtUntyped = LoadResString(l) 

' cboVarDelimiter.Listlndex = 0 ' default to "@" 
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cboPrecision.Listlndex = 1 ' default to ".01" 



cdlCD.CancelError = True 

If mbytAddEditFlag - aeEdit Then 

txtVariableName = mudtVar.name 

If mudtVar. Checksum Then 

chkChecksum ^ 1 
Else 

chkChecksum = 0 
End If 

Select Case TypeName(mudtVar) 

Case "Varlnteger" 

Set mudtVarInt = mudtVar 
With mudtVarInt 
txtProm = .From 
txtTo = .Too 
txtBy - .By 
If .Islndependent Then 
chklslndependent = 1 
Else 

chklslndependent = 0 
End If 
End With 

mudtType = vtlnteger 

Case "VarReal" 

Set mudtVarReal = mudtVar 
With mudtVarReal 
txtFrom = .From 
txtTo = .Too 
txtBy = .By 
If .Islndependent Then 
chklslndependent = 1 
Else 

chklslndependent = 0 
End If 

If .IsOnGrid Then 
chkOnGrid = 1 

Else 

chkOnGrid = 0 



End If 

If .TrailingZeros Then 
chkTrailingZeros = 1 
Else 

chkTrailingZeros = 0 
End If 

cboPrecision = .Precision 
End With 

mudtType - vtReal 

Case "VarFraction" 

Set mudtVarFraction = mudtVar 
With mudtVarFraction 

txtFromNum = .FromNumerator 

txtFromDen = .FromDenominator 

txtToNum = .ToNumerator 

txtToDen = .ToDenominator 

txtByNum ^ .ByNumerator 

txtByDen = .ByDenominator 

If .Islndependent Then 
chklslndependent = 1 

Else 

chklslndependent = 0 
End If 

If .MixedNumbers Then 
chkMixedNumbers = 1 
Else 

chkMixedNumbers = 0 
End If 
End With 

mudtType =^ vtFraction 

Case "VarString" 

Set mudtVarString = mudtVar 
With mudtVarString 
mudtType = vtString 

If .Delimiter - Chr(STRING_DELIMITER) Then 

' do nothing 
Else 

ConvertDelimiter 

.Delimiter = Chr(STRING_DELIMITER) 
End If 

' load list view control 
If Jslndexed Then 
chklndexed = 1 



VBSCA -232- 



Else 

chklndexed = 0 
End If 

LoadListView 
End With 

Case "VarUntyped" 
Set mudtVarUntyped = mudtVar 
mudtType = vtUntyped 

End Select 

mudtOldType = mudtType 

cboVarType.Listlndex = mudtType 'generates a cboVarType_Click event 

Else ' it's an add 

mudtType = vtlnteger 
mudtOldType = mudtType 

cboVarType.Listlndex ^ vtlnteger 'generates a cboVarType__Click event 
End If 

' changes control states if model is frozen 
UpdateControIStates 



End Sub 

Private Sub cmdVarOK_Click() 

' will capitahze the first letter of the variable name, if it's not 

' capitalized already. 

txtVariableName_LostFocus 

' make sure all input is vahd, otherwise, make 'em fix it! 
If VaHdateForm = False Then 

Exit Sub 
End If 

If mbytAddEditFlag = aeEdit Then ' we're editing an old one 

Call ProcessEdit 
Else 

Call ProcessAdd 
End If 
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Unload Me 
End Sub 

Private Sub cmdVarCancel_Click() 

Unload Me 
End Sub 

Private Sub cmdVarImport_Click() 

Dim strFN As String 

With cdlCD 
.FileName="" 

.DialogTitle = "Import strings from file" 
.Filter = "String Files (*.str)|*.strr 
.DefaultExt = ".str" 
JnitDir ^ "c:\tcs\tca\strings" 

.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly 
On Error GoTo Cancel 
.ShowOpen 
On Error GoTo 0 
StrFN = .FileName 
End With 

On Error GoTo Beatit ' trap open, I/O errors 

Open StrFN For Input Access Read As 1 

Dim varR As Variant 
Dim varlndexed As Variant 
Dim varNumlndices As Variant 
Dim strMessage As String 
Dim mcolStr As Collection 
Dim inti As Integer 

Input #1, varlndexed 

If varlndexed Then 

strMessage = "indexed." 
Else 

StrMessage = "not indexed." 
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End If 



If varlndexed o chklndexed Then 

Call MsgBox("Unable to import: file contains string values that 
strMessage, vbExclamation, "Error") 

GoTo Beatit 
End If 

Input #1, varNumlndices 
Do 

Input #1, varR 
If varlndexed Then 

Set mcolStr = New Collection 
Call mcolStr.Add(varR) 
For inti = 1 To varNumlndices - 1 
Input #1, varR 
Call mcolStr.Add(varR) 
Next intI 

Call AddColToListView(mcolStr) 
Else 

Call AddStrToListView(varR) 
End If 

Loop Until EOF(l) 

BeatIt: 
Close 1 

Cancel: 
Exit Sub 

End Sub 

Private Sub cmdVarExport_Click() 

Dim strFN As String 

cdlCD.CancelError = True 

With cdlCD 
.FileName = 

.DialogTitle = "Export strings to file" 
.Fiher = "String Files (*.str)|*.str|" 
.DefaultExt = ".txt" 



VBSCA -235- 



.InitDir = "c:\tcs\tca\strings" 

.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly 
On Error GoTo Cancel 
.ShowSave 
On Error GoTo 0 
strFN = .FileName 
End With 

On Error GoTo Beatit 

Open StrFN For Output Access Write As 1 

Dim varW As Variant 

varW = chklndexed ' so we can tell if it's indexed 
Print #l,varW 

varW = IvwStrings.ColumnHeaders.Count ' how many indices 
Print #l,varW 

Dim inti As Integer 
Dim intI2 As Integer 
Dim Isiltem As Listltem 

intI = 1 

Do ' write the data 

Set Isiltem = IvwStrings.Listltems.Item(intl) 
varW = Isiltem. Text 
Print #l,varW 

If chklndexed Then 
For intI2 = 1 To IvwStrings.ColumnHeaders.Count - 1 
varW - Isiltem. SubItems(intI2) 
Print #l,varW 
Next intI2 
End If 

intI = intI + 1 
Loop Until intI > IvwStrings.Listltems.Count 

Beatit: 
Close 1 

Cancel: 
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Exit Sub 
End Sub 

Private Sub lvwStrings__MouseDown(Button As Integer, Shift As Integer, 
5 X As Single, Y As Single) 

If Button - vbRightButton Then 

PopupMenu mnuString 
End If 

10 End Sub 

Private Sub mnuString Add_Click() 

If chklndexed Then 
With frmlndexedString 
' set the model 
1 .Model = mudtModel 

% ' set the edit flag 

35 . AddEditFlag = aeAdd 

yi ' set var name 

,1: . VariableName = txtVariableName 

2Q] ' do it 

J;;^ .Show vbModal 

a]: If .OK Then 

Call AddColToListView(.SubStringCollection) 
C3 End If 

2f; End With 

Else 

U., With frmString 

' set the model 
.Model = mudtModel 
30 'set the string 

.StringValue-"" 
' set var name 

.VariableName = txtVariableName 
'do it 

35 .Show vbModal 

If .OK Then 

Call AddStrToListView(.StringValue) 
End If 
End With 
40 End If 
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UpdateControlStates 
End Sub 

Private Sub mnuStringEdit_Click() 
Dim colC As Collection 

If IvwStrings.Selectedltem Is Nothing Then Exit Sub ' Make sure list item is selected 

If chklndexed Then 
With jSmlndexedString 
' set the model 
.Model = mudtModel 
' set the edit flag 
.AddEditFlag = aeEdit 
' set the substring collection 

.SubStringCollection = GetSubStringCollection(lvwStrings.Selectedltem) 
' set var name 

.VariableName = txtVariableName 
'do it 

.Show vbModal 
If .OK Then 

Call UpdateListView(lvwStrings.SelectedItem, .SubStringCoUection) 
End If 
End With 
Else 

With frmString 
' set the model 
.Model = mudtModel 
' set the string 

.StringValue = IvwStrings.Selectedltem 
' set var name 

.VariableName = txtVariableName 
'do it 

.Show vbModal 
If .OK Then 

Set colC = New Collection 

Call colC.Add(.StringValue) 

Call UpdateListView(lvwStrings.SelectedItem, colC) 
End If 
End With 
End If 

End Sub 
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Private Sub mnuStringRemove_Click() 

If IvwStrings.Selectedltem Is Nothing Then Exit Sub 

If MsgBox("Remove string value " & IvwStrings.Selectedltem.Text & "?" 

vbQuestion + vbYesNo) = vbNo Then 

Exit Sub 
End If 

With IvwStrings 

C all . Li stitenas .Remo ve( . S elect edit em , index) 
End With 

UpdateControlStates 
End Sub 

Private Sub chkIsIndependent_Click() 

Call FormatForm 
End Sub 

Private Sub cboVarType_Click() 

mudtType = cboVarType.Listlndex 

Call FormatForm 
End Sub 

Private Sub txtVariableName__GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtS elect All(txtVariableName) 

End Sub 

Private Sub txtVariableName_LostFocus() 

Dim strName As String 
Dim udtVar As Variable 

' CapitaUze the variable name in the textbox 
StrName = txtVariableName 
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Call CapitalizeString(strName) 
txtVariableName = strName 

End Sub 

Private Sub txtFrom_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtFrom) 

End Sub 

Private Sub txtTo_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtTo) 

End Sub 

Private Sub txtBy_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtBy) 

End Sub 

Private Sub txtFromNum_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtFromNum) 

End Sub 

Private Sub txtFromDen_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtFromDen) 

End Sub 

Private Sub txtToNum_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtToNum) 



VBSCA -240- 



End Sub 



Private Sub txtToDen_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtToDen) 

End Sub 

Private Sub txtByNum_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtByNum) 

End Sub 

Private Sub txtByDen_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtByDen) 

End Sub 

Private Sub FormatForm() 

cmdVarlmport.Visible = False 
cmdVarExport. Visible = False 

chklsIndependent.TabStop = False 
txtFrom.TabStop = False 
txtTo.TabStop = False 
txtBy.TabStop = False 
txtFromNum.TabStop = False 
txtFromDen.TabStop = False 
txtToNum.TabStop = False 
txtToDen.TabStop = False 
txtByNum.TabStop = False 
txtByDen.TabStop = False 
IvwStrings. Tab Stop = False 
chkTrailingZeros.TabStop = False 
chkTrailingZeros.TabStop = False 
chkMixedNumbers.TabStop = False 

Select Case mudtType 
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Case vtlnteger 

fraFractionRange. Visible = False 
fraFractionFormat. Visible = False 
fralndependent.ZOrder 
fralntRealRange.ZOrder 
fraRealFormat.Visible = False 
chklsIndependent.TabStop = True 
If chklslndependent Then 

fralntRealRange, Visible = True 

txtFrom.TabStop = True 

txtTo.TabStop = True 

txtBy.TabStop = True 
Else 

fralntRealRange.Visible ^ False 
End If 

Case vtReal 

fraFractionRange.Visible ^ False 
fraFractionFormat.Visible = False 
fralndependent.ZOrder 
fralntRealRange.ZOrder 
fraRealFormat.ZOrder 
fraRealFormat.Visible = True 
chklsIndependent.TabStop = True 
If chklslndependent Then 

fralntRealRange.Visible = True 

txtFrom.TabStop = True 

txtTo.TabStop = True 

txtBy.TabStop - True 
Else 

fralntRealRange.Visible = False 
End If 

chkOnGrid.TabStop - True 
chkTrailingZeros.TabStop ^ True 

Case vtFraction 

fralntRealRange.Visible = False 
fraRealFormat.Visible = False 
fralndependent.ZOrder 
fraFractionRange . ZOrder 
fraFractionFormat.ZOrder 
fraFractionFormat.Visible ^ True 
chklsIndependent.TabStop = True 
If chklslndependent Then 

fraFractionRange.Visible = True 



txtFromNum.TabStop = True 
txtFromDen.TabStop = True 
txtToNum.TabStop = True 
txtToDen.TabStop = True 
txtByNum.TabStop = True 
txtByDen.TabStop = True 
Else 

fraFractionRange. Visible = False 
End If 

chkMixedNumbers.TabStop = True 

Case vtString 
fraString.ZOrder 
cmdVarlmport. Visible = True 
cmdVarExport. Visible = True 

Case vtUntyped 
fraUntyped.ZOrder 

End Select 

Dim intTablndex As Integer 
intTablndex = 4 

Call AddTab(chkIsIndependent, intTablndex) 

Call AddTab(txtFrom, intTablndex) 

Call AddTab(txtTo, intTablndex) 

Call AddTab(txtBy, intTablndex) 

Call AddTab(txtFromNum, intTablndex) 

Call AddTab(txtFromDen, intTablndex) 

Call AddTab(txtToNum, intTablndex) 

Call AddTab(txtToDen, intTablndex) 

Call AddTab(txtByNum, intTablndex) 

Call AddTab(txtByDen, intTablndex) 

Call AddTab(chkTrailingZeros, intTablndex) 

Call AddTab(chkOnGrid, intTablndex) 

Call AddTab(chkMixedNumbers, intTablndex) 

End Sub 

' add a tab, if its active 

Private Sub AddTab(ByVal ctlC As Control, intlndex As Integer) 
IfctlC.TabStopThen 



VBSCA -243- 



ctlC.Tablndex = intlndex 
intlndex = intlndex + 1 
End If 

End Sub 

Private Function ValidateFormQ As Boolean 

ValidateForm ^ False 

' check variable name length > 0 
If Len(txtVariableName) = 0 Then 

Call MsgBox("Variable names must be 1 or more characters long.", _ 
vbExclamation, "Error") 

txtVariableName.SetFocus 

Exit Function 
End If 

'check first character for alpha 

If Asc(txtVariableName) < 65 Or Asc(txtVariableName) > 91 Then 

Call MsgBox(" Variable names must begin in a letter", _ 
vbExclamation, "Error") 

txtVariableName.SetFocus 

Exit Function 
End If 

' check for unique variable name 
Dim blnUnique As Boolean 
blnUnique = True 

Select Case mbytAddEditFlag 

Case aeAdd 

blnUnique ^ mudtModel.Variables.UniqueName(txtVariableName) 
Case aeEdit 

blnUnique = mudtModel.Variables.UniqueName(txtVariableName, 1, mudtVar) 
End Select 

If blnUnique = False Then 

Call MsgBox("Variable name is already in use.", vbExclamation, "Error") 

txtVariableName. SetFocus 

Exit Function 
End If 
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' if integer or real, validate contents of From, To, By 
If cboVarType = "Integer" Or cboVarType = "Real" Then 
If Not ValidateRange Then 

Call MsgBox("Entries in From, To, and By must be either a number " 
"or a string variable containing a numeric value, " & _ 
"Expressions or math variables are not permitted.", _ 
vbExclamation, "Error") 
Exit Function 
End If 
End If 

ValidateForm = True 
End Function 

Private Function ValidateRangeQ As Boolean 

Dim conC As Control 
Dim colC As New Collection 
Dim udtV As Variable 
Dim udtVS As VarString 
Dim inti As Integer 
Dim blnOK As Boolean 

Call colC.Add(txtFrom) 
Call colC.Add(txtTo) 
Call colC.Add(txtBy) 

For Each conC In colC 
blnOK = False 
If IsNumeric(conC) Then 

blnOK = True 
Else ' see if the box contains a string variable 
For Each udtV In mudtModel.Variables 
If udtV.Typ = vtString Then 
Set udtVS = udtV 
If udtVS.IsIndexed Then 

For intI = 1 To udtVS.Numlndices 

If conC = GetIndexedName(udtV.name, intI) Then 
blnOK = True 
Exit For 
End If 
Next intI 
Elself conC = udtV.name Then 
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blnOK = True 
End If 
End If 

IfblnOK Then 

Exit For 
End If 
Next udtV 
End If 

If Not blnOK Then 

ValidateRange = False 

Exit Function 
End If 
Next conC 

ValidateRange = True 

End Function 

Private Sub ProcessEditQ 

' Check to see if the type has changed 
If mudtType <> mudtOldType Then 

With mlstListBox 

' remove the old variable from the collection 

Call mudtModel.Variables.Remove(Str(.ItemData(.ListIndex))) 

' add the new variable 

Call AddVariable 

' update the index in the list box 

.ItemData(.Listlndex) = mudtVar index 

' replace the text in the list box 

.List(.Listlndex) = mudtVar.ScreenFormat 
End With 

Else 

' update it with new data from form 
Select Case mudtType 

Case vtlnteger 

Call mudtVarInt.Update(txtVariableName, _ 
txtFrom, txtTo, txtBy, _ 
chklslndependent, chkChecksum) 

Case vtReal 

Call mudtVarReaLUpdate(txtVariableName, _ 
txtFrom, txtTo, txtBy, chklslndependent, _ 
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chkChecksum, chkTrailingZeros.Value, cboPrecision, chkOnGrid) 

Case vtFraction 

Call mudtVarFraction.Update(txtVariableName, _ 
txtFromNum, txtFromDen, txtToNum, txtToDen, _ 
txtByNum, txtByDen, chklslndependent, chkChecksum, _ 
chkMixedNumbers) 

Case vtString 
Dim inti As Integer 
Dim intI2 As Integer 
Dim colStr As Collection 
Dim udtSS As Substring 

mudtVar.name = txtVariableName 
mudtVar. Checksum = chkChecksum 
mudtVarString Jslndexed = chklndexed 

' build a new collection of strings 
Set colStr = New Collection 
With IvwStrings 

For intI = 1 To (.Listltems.Count) 
Set udtSS = New Substring 
udtSS. Delimiter = mudtVarString.Dehmiter 
Call udtSS.AddSubString(.ListItems.Item(intI).Text) 
For intI2 = 1 To .ColumnHeaders.Count - 1 

Call udtSS.AddSubString(.ListItemsJtem(intI).SubItems(intI2)) 

Next intI2 

Call colStr.Add(udtSS.StringValue) 
Next intI 
End With 

mudtVarString. StringCoUection colStr 
End Select 

With mlstListBox 

' replace the text in the list box 

Xist(.Listlndex) = mudtVar.ScreenFormat 
End With 

End If 

End Sub 

Private Sub ProcessAddQ 
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Call AddVariable 



With mlstListBox 

• Add the new variable to the variable list box 

Call .Addltem(mudtVar.ScreenFormat) 

' Set ItemData to index value of the variable object 

JtemData(.ListCount - 1) =mudtVar,index 

' Check the check box 

.Selected(.ListCount - 1) = Trae 
End With 

End Sub 

Private Sub AddVariableQ 

' Add the new variable 
Select Case mudtType 

Case vtlnteger 

Set mudtVar = mudtModel.Variables.AddInteger(txtVariableName, _ 
True, txtFrom, txtTo, txtBy, chklslndependent, _ 
chkChecksum) 

Case vtReal 

Set mudtVar - mudtModeLVariables.AddReal(txtVariableName, _ 
True, txtFrom, txtTo, txtBy, chklslndependent, _ 
chkChecksum, chkTrailingZeros.Value, cboPrecision, chkOnGrid) 

Case vtFraction 

Set mudtVar = mudtModeLVariables.AddFraction(txtVariableName, 
True, txtFromNum, txtFromDen, txtToNum, txtToDen, _ 
txtByNum, txtByDen, chklslndependent, chkChecksum, 
chkMixedNumbers) 

Case vtString 

Dim inti As Integer 

Dim intI2 As Integer 

Dim colStr As New Collection 

Dim udtSS As Substring 

With IvwStrings 

For intI = 1 To (Xistltems. Count) 
Set udtSS = New Substring 
udtSS.Delimiter = Chr(STRING_DELIMITER) 
udtSS.AddSubString (.ListltemsJtem(intl).Text) 
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For intI2 = 1 To .ColumtiHeaders.Count - 1 

Call udtSSAddSubString(.ListItemsJtem(intI).SubItems(intI2)) 

Next intI2 
Call colStr.Add(udtSS.StringValue) 

Next intl 
End With 

Set mudtVar = mudtModelVariables.AddString(txtVariableName, True, _ 
chkChecksum, Chr(STRING_DELIMITER), chklndexed, colStr) 

Case vtUntyped 

Set mudtVar = mudtModel.Variables.AddUntyped(txtVariableName, True, 
chkChecksum) 

End Select 

End Sub 

Private Sub UpdateControlStatesQ 
Dim conC As Control 
On Error Resume Next 

' shut off all controls that have an enabled property 
For Each conC In Me 

If mudtModel.IsFrozen Then 
conC. Enabled = False 

Else 

conC.Enabled = True 
End If 
Next conC 

On Error GoTo 0 

' these stay on even if model is frozen 
cmdVarCancel.Enabled = True 
fraString.Enabled = True 
IvwStrings.Enabled ^ True 
cmdEdit.Enabled = True 
mnuStringEdit.Enabled = True 

' if model is frozen, change caption of edit button, menu to browse 
If mudtModel.IsFrozen Then 

cmdEdit.Caption = "Browse" 

mnuStringEdit.Caption - "Browse" 



VBSCA -249- 



End If 

' turn export on if there's something to export 
cmdVarExport.Enabled = CBool(lvwStrings.Listltems.Count) 

5 • shut off "edit", "remove" buttons, menus if the listview is empty 

If IvwStrings.Listltems.Count = 0 Then 
mnuStringEdit.Enabled = False 
cmdEdit.Enabled = False 
mnuStringRemove.Enabled = False 
1 0 cmdRemove.Enabled = False 

End If 

End Sub 

' this is used to convert version 0.6 indexed strings to version 0.7 style 
Private Sub ConvertDelimiterQ 



Dim colStr As Collection 
Dim varS As Variant 

With mudtVarString 
• 2(^1 Set colStr = .StringCoUection 

For Each varS In colStr 

varS - ReplaceAll(varS, .Delimiter, Chr(STRING_DELIMITER)) 

1, Next varS 

End With 

"I End Sub 



Private Sub LoadListViewQ 

Dim inti As Integer 
Dim varS As Variant 

With mudtVarString 
If chklndexed Then 
' build column headers 
For intI = 1 To .Numlndices - 1 

Call IvwStrings.ColumnHeaders Add(, , _ 
Str(intl), IvwStrings. Width / 4) 
Next intI 
End If 

' fill in values 
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For Each varS In .StringCollection 

Call AddStrToListView(varS) 
Next varS 
End With 

End Sub 

Private Sub AddColToListView(ByVal colS As Collection) 
Dim IsiLI As Listltem 

Set IsiLI = lvwStrings.ListItems.Add(, , "") 
Call UpdateListView(lsiLI, colS) 

End Sub 

Private Sub AddStrToListView(ByVal strS As String) 

Dim udtSS As New Substring 
Dim IsiLI As Listltem 
Dim inti As Integer 

Set IsiLI = lvwStrings.ListItems.Add(, , "") 
udtSS.Delimiter = Chr(STRING_DELIMITER) 
udtSS.StringValue = strS 

Call UpdateListView(lsiLI, udtSS.StringCoUection) 
End Sub 

Private Sub UpdateListView(ByVal IsiLI As Listltem, ByVal colS As Collection) 

Dim intI As Integer 

Dim intW As Integer 

Dim strColHeading As String 

If chklndexed Then 

intW = 4 
Else 

intW = 1 
End If 

' expand the number of columns if there aren't enough 
For intI = IvwStrings.ColumnHeaders.Count To colS.Count - 1 
If chklndexed Then 

StrColHeading = Str(intl + 1) 
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Call IvwStrings.ColumnHeaders .Add(, , strColHeading, _ 
IvwStrings.Width / intW) 

Else 

strColHeading = " " 

Call lvwStrings.ColumnHeaders.Add(, , strColHeading) 
End If 
Next inti 

' plug in the values 

For intI = 1 To colS. Count 

Ifintl= 1 Then 

IsiLI = colS.Item(intl) 

Else 

lsiLLSubItems(intI - 1) - colS Jtem(intl) 
End If 
Next intI 

' get rid of anything in the list view past colS. Count 
For intI = colS.Count + 1 To IvwStrings.ColumnHeaders.Count 
Ifintl> 1 Then 

lsiLLSubItems(intI - 1) - 
Else 

IsiLI = 
End If 
Next intI 

Dim blnEmpty As Boolean 

' get rid of columns with all "" from right to left 
' stop when first column with any string > 0 length is encountered 
For intI = IvwStrings.ColumnHeaders.Count To 1 Step -1 
For Each IsiLI In IvwStrings.Listltems 
blnEmpty = True 
Ifintl> 1 Then 

If lsiLLSubItems(intI - 1) <> Then 
blnEmpty = False 
Exit For 
End If 
Elself IsiLI <> Then 
blnEmpty = False 
Exit For 
End If 
Next IsiLI 
If blnEmpty Then 

Call IvwStrings.ColumnHeaders.Remove(intl) 
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Else 

Exit For 
End If 
Next inti 

Dim intI2 As Integer 

' get rid of rows with "" in all columns from the bottom up 
For intI2 = IvwStrings.Listltems, Count To 1 Step -1 
Set IsiLI = lvwStrings.ListItems.Item(intI2) 
For intI = 1 To IvwStrings.ColumnHeaders.Count 
blnEmpty = True 
Ifintl> 1 Then 
If lsiLLSubItems(intI - 1) <> Then 
blnEmpty = False 
Exit For 
End If 
Elself IsiLI <> Then 
blnEmpty = False 
Exit For 
End If 
Next intI 

If blnEmpty Then 

Call lvwStrings.ListItems.Remove(intI2) 
End If 
Next intI2 

End Sub 

Private Function GetSubStringCollection(ByVal IsiLI As Listltem) As Collection 

Dim colC As New Collection 
Dim intI As Integer 

Call colC.Add(lsiLI) 

For intI = 1 To IvwStrings.ColumnHeaders.Count - 1 

Call colC.Add(lsiLLSubItems(intI)) 
Next intI 

Set GetSubStringCollection = colC 
End Function 
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' Application.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l True 
Persistable = 0 'NotPersistable 
DataBindingBehavior = 0 'vbNone 
DataSourceBehavior =0 'vbNone 
MTSTransactionMode =0 "NotAriMTS Object 
END 

Attribute VB_Name = "TCAApplication" 
Attribute VB_GlobalNanieSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 

Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes" 
Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 
Option Explicit 



Public Sub Run() 

' Dim udtP As New Prolog 

' If udtP.StartProlog("hlp41ib.p4") = False Then 

Call MsgBox("Prolog failure on startup", vbExclamation, "Error") 
' End If 

frmTCA.Show 

End Sub 
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' CClonesxls 
VERSION 1.0 CLASS 
BEGIN 
MultiUse--! True 
END 

Attribute VB_Name = "CClones" 
Attribute VB__GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

' enable i/o 

Private mudtFile As File 

'to hold collection 

Private mcolClones As Collection 

' the sequence number appended to clone filenames 
Private mintSeqNum As Integer 

' is dirty 

Private mblnlsDirty As Boolean 

Private Sub Class_Initialize() 

'creates the collection when this class is created 
Set mcolClones = New Collection 

End Sub 

Private Sub Class_Terminate() 

'destroys collection when this class is terminated 
Set mcolClones = Nothing 

End Sub 

Public Property Get Item(vntIndexKey As Variant) As Clone 

'used when referencing an element in the collection 
'vntlndexKey contains either the Index or Key to the collection, 
'this is why it is declared as a Variant 
'Syntax: Set foo = x.Item(xyz) or Set foo = xJtem(5) 
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Set Item = mcolClones(vntlndexKey) 
End Property 

Public Property Get CountQ As Long 

'used when retrieving the number of elements in the 
'collection. Syntax: Debug.Print x.Count 
Count = mcolClones. Count 

End Property 

Public Property Get NextSeqNum() As Integer 

mintSeqNum = mintSeqNum + 1 
NextSeqNum = mintSeqNum 

mblnlsDirty ^ True 

End Property 

Public Property Let SeqNum(ByVal intNewValue As Integer) 

mintSeqNum = intNewValue 

mblnlsDirty ^ True 
End Property 

Public Property Get SeqNum() As Integer 

SeqNum = mintSeqNum 
End Property 

Public Property Get IsDirtyQ As Boolean 

Dim udtClone As Clone 

' see if any collection members are dirty 
If Not mblnlsDirty Then 

For Each udtClone In mcolClones 
IfudtClone.IsDirty Then 
mblnlsDirty = True 
Exit For 

VBSCA -256- 



3 



End If 
Next udtClone 
► End If 

5 IsDirty = mblnlsDirty 

End Property 

> 

Private Function NextlDQ As Long 

' creates a unique index to associate a clone and a listbox 
10 Static InglD As Long 

InglD = InglD + 1 
NextID - InglD 

15 End Function 

Public Function Add(ByVal strFN As String, _ 
i I Optional ByVal blnAddSeqNum = False) As Clone 

Dim udtClone As New Clone 

9 205f ' add the clone sequence number to the file name if blnAddSeqNum is True. 
■ : If blnAddSeqNum Then 

udtClone.FileName = left(strFN, Len(strFN) - 4) & _ 
U Trim(Str(NextSeqNum)) & ".doc" 

Else 

^ 25; : udtClone.FileName = ExtractFileName(strFN) 

C End If 

3 udtCloneindex = NextID 

^30 ' use index of the clone as the key 

Call mcolClones.Add(udtClone, Str(udtClone.Index)) 

Set Add -udtClone 
^ End Function 

35 Public Function AddObj(ByVal udtClone As Clone) As Clone 

udtClone .Index = NextID 
• ' use index of the clone as the key 
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Call mcolClones. Add(udtClone, Str(udtClone.Index)) 
Set AddObj - udtClone 
End Function 

Public Sub Remove(vntIndexKey As Variant) 

'used when removing an element from the collection 
VntlndexKey contains either the Index or Key, which is why 
'it is declared as a Variant 
'Syntax: x.Remove(xyz) 
mcolClones.Remove vntlndexKey 

mblnlsDirty = True 

End Sub 

Public Property Get NewEnumQ As lUnknown 
Attribute NewEnum. VB_UserMemId = -4 

'this property allows you to enumerate 
'this collection with the For... Each syntax 
Set NewEnum = mcolClones.[_NewEnum] 

End Property 

Public Sub ClearO 

' empties the collection class 

Set mcolClones = Nothing 

Set mcolClones = New Collection 

mblnlsDirty = True 

End Sub 

Public Sub ReadCollection(ByVal strFN As String, ByVal IngStartlndex As Long, 
ByVal IngEndlndex As Long) 

Set mudtFile = New File 

mudtFile.FileName = strFN 

Call mudtFile.ReadFile(Me, IngStartlndex, IngEndlndex) 
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Set mudtFile = Nothing 
End Sub 

Public Sub ReadObjectsO 

Dim udtClone As Clone 

On Error GoTo Beatit 

Do Until Err.Number <> 0 

Set udtClone = New Clone 

Call udtClone.ReadObjectData(mudtFile) 

udtClone .Index NextID 

Call mcolClones.Add(udtClone, Str(udtClone.Index)) 

Loop 
Beatit: 

Exit Sub 
End Sub 

Public Function WriteCollection(ByVal strFN As String, _ 
ByVal InglndexPos As Long, ByVal IngSeekPos) As Long 

Set mudtFile = New File 

mudtFile.FileName = strFN 

WriteCollection = mudtFile.WriteFile(Me, False, InglndexPos, IngSeekPos) 

Set mudtFile = Nothing 

mblnlsDirty = False 
End Function 
Public Sub WriteObjectsO 

Dim udtClone As Clone 

For Each udtClone In mcolClones 
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Call udtClone. WriteObj ectData(mudtFile) 
Next udtClone 



End Sub 



' CConstraints.cls 
VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l Trae 
END 

Attribute VB^Name = "CConstraints" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed False 
Option Explicit 

' enable i/o 

Private mudtFile As New File 

'local variable to hold collection 
Private mcolConstraint As Collection 

' is dirty 

Private mblnlsDirty As Boolean 

Public Property Let IsDirty(ByVal blnNev^Value As Boolean) 

mblnlsDirty = blnNewValue 
End Property 

Public Property Get IsDirtyQ As Boolean 

Dim udtCon As Constraint 

For Each udtCon In mcolConstraint 
IfudtConJsDirty Then 
mblnlsDirty = True 
Exit For 
End If 
Next udtCon 

IsDirty = mblnlsDirty 

End Property 

Private Sub Class_Initialize() 
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'creates the collection when this class is created 
Set mcolConstraint = New Collection 

End Sub 

Private Sub Class_Temiinate() 

'destroys collection when this class is terminated 
Set mcolConstraint = Nothing 

End Sub 

Public Property Get Item(vntIndexKey As Variant) As Constraint 

'used when referencing an element in the collection 

'vntlndexKey contains either the Index or Key to the collection, 

'this is why it is declared as a Variant 

'Syntax: Set foo = x Jtem(xyz) or Set foo = x.Item(5) 

Set Item = mcolConstraint(vntlndexKey) 

End Property 

Public Property Get CountQ As Long 

'used when retrieving the number of elements in the 
'collection. Syntax: Debug.Print x.Count 
Count = mcolConstraint. Count 

End Property 

Public Sub AddObject(udtCon As Constraint) 
' adds constraint objects directly to the collection 
udtCon.Index - NextID 

Call mcolConstraint. Add(udtCon, Str(udtCon.Index)) 
mblnlsDirty = True 
End Sub 

Public Function Add(ByVal strConstraint As String, ByVal blnEnabled As Boolean, 
ByVal udtType As ConstraintType, ByVal strComment As String) As Constraint 

'create anew object 
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Dim objNewMember As Constraint 
Set objNewMember = New Constraint 

'set the properties passed into the method 
With objNewMember 

.ConstraintString strConstraint 

.Enabled = blnEnabled 

.ConstraintType = udtType 

.Comment = strComment 

.Index = NextID 

' add the new object to the collection 
Call mcolConstraint.Add(objNewMember, Str$(.Index)) 
End With 

'return the object created 
Set Add = objNewMember 
Set objNewMember = Nothing 

mblnlsDirty = True 

End Function 

Public Sub Remove(vntIndexKey As Variant) 

'used when removing an element from the collection 
VntlndexKey contains either the Index or Key, which is why 
'it is declared as a Variant 
'Syntax: x.Remove(xyz) 
mcolConstraint.Remove vntlndexKey 

mblnlsDirty = True 

End Sub 

Pubhc Function NewEnum() As lUnknown 
Attribute NewEnum. VB_UserMemId = -4 
Attribute NewEnum.VB^MemberFlags = "40" 

'this property allows you to enumerate 
'this collection with the For... Each syntax 
Set NewEnum = mcolConstraint.LNewEnum] 

End Function 

Private Function NextID () As Long 
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' creates a unique index to associate a constraint and the constraint listbox(es) 
Static ingID As Long 

IngID = InglD + 1 
NextID = IngID 

End Function 

' returns true if strCon is already a constraint in the collection. Used 
' when importing constraints to make sure dups are not introduced. 
Public Function UniqueConstraint(ByVal strCon As String) As Boolean 

Dim udtCon As Constraint 

UniqueConstraint = True 

' Check for duplicate constraint 
For Each udtCon In mcolConstraint 

If StrCon = udtCon, ConstraintString Then 
UniqueConstraint - False 
Exit For 
End If 
Next udtCon 

End Function 

PubUc Sub ReadCollection(ByVal strFN As String, ByVal IngStartlndex As Long, 
ByVal IngEndlndex As Long) 

mudtFile.FileName = strFN 

Call mudtFile.ReadFile(Me, IngStartlndex, IngEndlndex) 
End Sub 

Pubhc Sub ReadObjectsO 

Dim udtCon As Constraint 

On Error GoTo Beatit 

Do Until Err.Number <> 0 

Set udtCon = New Constraint 

Call udtCon.ReadObjectData(mudtFile) 

udtCon. Index = NextID 
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Call mcolConstraint.Add(udtCon, Str(udtCon.Index)) 

Loop 
Beatit: 

Exit Sub 
End Sub 

Public Function WriteCollection(ByVal strFN As String, _ 
ByVal InglndexPos As Long, ByVal IngSeekPos) As Long 

mudtFile.FileName = strFN 

WriteCollection = mudtFile.WriteFiIe(Me, False, InglndexPos, IngSeekPos) 

mblnlsDirty = False 
End Function 
Public Sub WriteObjectsO 

Dim udtCon As Constraint 

For Each udtCon In mcolConstraint 
Call udtCon. WriteObjectData(mudtFile) 

Next udtCon 
End Sub 

Public Sub Clear(ByVal udtType As VariableType) 

' empties the collection class of all constraints of type udtType 

Dim udtCon As Constraint 

For Each udtCon In mcolConstraint 

If udtCon. ConstraintType = udtType Then 

Call mcolConstraint.Remove(Str(udtCon.Index)) 
End If 

Next udtCon 
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End Sub 



' returns true if an enabled string variable name was used 
' in any enabled constraint 

Public Function StringVarNamesUsed(ByVaI udtCVar As CVariables) As Boolean 

' First create a collection of all enabled constraint strings 

Dim udtCon As Constraint 

Dim colStrings As New Collection 

For Each udtCon In mcolConstraint 

If udtCon.Enabled Then 

colStrings.Add udtCon. Constraints tring 

End If 
Next udtCon 

' create a variable collection with variable names sorted in length 
' from longest to shortest 
Dim udtSCVar As CVariables 

Set udtSCVar = udtCVar.SortVarNamesByLength 

' nibble variable names out of the string collection, using enabled 
' variable names sorted in length from longest to shortest 
Dim vntS As Variant 
Dim vntT As Variant 
Dim vntStart As Variant 
Dim udtVar As Variable 

For Each vntS In colStrings 
For Each udtVar In udtSCVar 
If udtVar. Enabled Then 
vntStart = InStr(l, vntS, udtVar.Name) 
If vntStart Then 
If udtVar. Typ = vtString Then 
String VarNamesUsed = True 
Exit Function 
Else 

vntT = vntS 

vntS = left(vntT, vntStart - 1) & _ 
right(vntT, Len(vntT) - vntStart - _ 
Len(udtVar.Name) +1) 
End If 
End If 
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End If 
Next udtVar 
Next vntS 

StringVarNamesUsed = False 



End Function 



' Checksum.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l Trae 
END 

Attribute VB_Name "Checksum" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = Trae 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Private mcolStr As Collection 

Private Sub Class_Initialize() 

Set mcolStr = New Collection 

End Sub 

Public Sub AddValue(ByVal strNewValue As String) 

Call mcolStr.Add(strNewValue) 
End Sub 

Public Function ComputeCSQ As Double 

Dim n As Integer 
Dim dblCS As Double 
Dim dblSum As Double 
Dim varStr As Variant 
Dim cntr As Integer 
Dim dblT As Double 

cntr = 1 

' On Error GoTo Overflow 

For Each varStr In mcolStr 
dblSum = 0 
n = Len(varStr) 
While n > 0 

dblSum - Asc(Mid(varStr, n, 1)) * n + dblSum 
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n = n- 1 
Wend 

dblCS = dblSum * cntr + dblCS 
cntr = cntr + 1 
Next varStr 

'Overflow: 

ComputeCS = dblCS 

Exit Function 
End Function 



' Clone.cls 

VERSION 1.0 CLASS 
BEGIN 

MultiUse--! Trae 
END 

Attribute VB_Name - "Clone" 
Attribute VB^GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer - 1 

' file name (without path) of this clone 
Private mstrFN As String 

' hold document handle 

Private mdocCloneDoc As Document 

' checksum of variables 

Private mdblChecksum As Double 

' index 

Private mlnglndex As Long 
' is dirty 

Private mblnlsDirty As Boolean 

' has been routed to TCS 
Private mbytlsRouted As Byte 

' program 

Private mudtProgram As Program 
' domain 

Private mudtDomain As Domain 
' the batch id 

Private mstrBatchID As String 
' the target template 

Private udtDeliveryMode As DeliveryMode 



' pure or real model 

Private mudtNature As Nature 

' TDer's estimate of difficulty (1-5) 
Private mbytTDEstimate As Byte 

' difficulty has been calculated 

Private mbytlsDifficultyCalculated As Byte 

' the key 

Private mstrKey As String 
' the item type 

Private mudtltemType As ItemType 

Public Enum Domain 

doArithmetic - 0 

doAlgebra = 1 

doDataAnalysis = 2 

doGeometry - 3 
End Enum 

Public Enum Nature 

naPure = 0 

naReal = 1 
End Enum 

' difficulty estimate 

Private mudtDE As DifficultyEstimate 
Private Sub Class_Initialize() 

mblnlsDirty = False 
End Sub 

Public Property Get FileNameQ As String 

FileName = mstrFN 
End Property 

Public Property Let FileName(ByVal strNewValue As String) 
If mstrFN <> strNewValue Then 
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mstrFN = strNew Value 
mblnlsDirty = Trae 
End If 

End Property 

Public Property Get CloneDocQ As Document 

Set CloneDoc = mdocCloneDoc 
End Property 

Public Property Let CloneDoc(ByVal docNewValue As Document) 

Set mdocCloneDoc ^ docNewValue 
End Property 

Public Property Get ChecksumQ As Double 

Checksum = mdblChecksum 
End Property 

Public Property Let Checksum(ByVal dblNewValue As Double) 

If mdblChecksum o dblNewValue Then 

mdblChecksum = dblNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get IndexQ As Long 

Index = mlnglndex 
End Property 

Public Property Let Index(ByVal IngNew Value As Long) 

If mlnglndex <> IngNew Value Then 

mlnglndex = IngNewValue 

mblnlsDirty = True 
End If 
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End Property 

Public Property Get IsDirtyQ As Boolean 
IsDirty = False 

If IsDifficultyCalculated Then ' don't check DE if difficultly hasn't been calculated! 
If mblnlsDirty Or mudtDE. IsDirty Then 

IsDirty = True 
End If 

Else 

If mblnlsDirty Then 

IsDirty = True 
End If 
End If 

End Property 

PubUc Property Get IsRoutedQ As Byte 

IsRouted = mbytlsRouted 
End Property 

Public Property Let IsRouted(ByVal bytNewValue As Byte) 

If mbytlsRouted o bytNewValue Then 

mbytlsRouted = bytNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get Program() As Program 

Program = mudtProgram 
End Property 

Public Property Let Program(ByVal udtNewValue As Program) 

If mudtProgram <> udtNewValue Then 
mudtProgram = udtNewValue 
mblnlsDirty = True 
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End If 
End Property 

Public Property Get DomainQ As Domain 

Domain = mudtDomain 
End Property 

Public Property Let Domain(ByVal udtNewValue As Domain) 

If mudtDomain <> udtNewValue Then 

mudtDomain = udtNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get IsDifficultyCalculatedQ As Byte 

IsDifficultyCalculated = mbytlsDifficultyCalculated 
End Property 

Public Property Let IsDifficultyCalculated(ByVal bytNewValue As Byte) 

If mbytlsDifficultyCalculated <> bytNewValue Then 

mbytlsDifficultyCalculated = bytNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get TDEstimate() As Byte 

TDEstimate = mbytTDEstimate 
End Property 

Public Property Let TDEstimate(ByVal bytNewValue As Byte) 

If mbytTDEstimate <> bytNewValue Then 
mbytTDEstimate = bytNewValue 
mblnlsDirty = True 
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End If 
End Property 

Public Property Get BatchlDQ As String 

BatchID - mstrBatchID 
End Property 

Public Property Let BatchID(ByVal strNewValue As String) 

If mstrBatchID <> strNewValue Then 

mstrBatchID - strNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get Key() As String 

Key = mstrKey 
End Property 

Public Property Let Key(ByVal strNewValue As String) 

If mstrKey o strNewValue Then 

mstrKey = strNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get ItemTypeQ As ItemType 

ItemType = mudtltemType 
End Property 

Pubhc Property Let ItemType(ByVal udtNewValue As ItemType) 

If mudtltemType o udtNewValue Then 
mudtltemType = udtNewValue 
mblnlsDirty = True 
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End If 
End Property 

Public Property Get DeliveryModeQ As DeliveryMode 

DeliveryMode = udtDeliveryMode 
End Property 

Public Property Let DeliveryMode(ByVal udtNewValue As DeliveryMode) 

If udtDeliveryMode o udtNewValue Then 

udtDeliveryMode = udtNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get Nature() As Nature 

Nature = mudtNature 
End Property 

Public Property Let Nature(ByVal udtNewValue As Nature) 

If mudtNature <> udtNewValue Then 

mudtNature = udtNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get DifflEstQ As DifficultyEstimate 

Set DiffEst = mudtDE 
End Property 

Public Property Let DiffEst(ByVal udtNewValue As DifficultyEstimate) 

Set mudtDE = udtNewValue 
mblnlsDirty = True 
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End Property 



Public Sub OpenDoc(ByVal udtWord As MSWord, ByVal strPath As String) 

Dim udtDS As New DocStatus 

If udtDS .IsOpen(mstrFN) = False Then 
Set mdocCloneDoc = _ 
udtWord.WordApp.Documents.Open(FileName:=strPath & mstrFN) 
End If 

mdocCloneDoc.Activate 
End Sub 

Public Sub CloseDocO 

Dim udtDS As New DocStatus 

If udtDS .IsOpen(mstrFN) Then 

Call mdocCloneDoc.Close(wdSaveChanges) ' save changes 

Set mdocCloneDoc = Nothing 
End If 

End Sub 

Public Sub ReadObjectData(udtFile As File) 
Dim vField As Variant 

Call udtFile.ReadField(vField) ' returns the version stamp 
Call udtFile.ReadField(vField) 
FileName = ExtractFileName(vField) 

Call udtFile.ReadField(vField) 

Key = ExtractFileName(vField) 

Call udtFile.ReadField(vField) 

ItemType = ExtractFileName(vField) 

Call udtFile.ReadField(vField) 

Program = vField 

Call udtFile.ReadField(vField) 

Domain = vField 

Call udtFile.ReadField(vField) 

BatchID = vField 

Call udtFile.ReadField(vField) 
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DeliveryMode = vField 
Call udtFile.ReadField(vField) 
Nature = vField 
Call udtFile.ReadField(vField) 
TDEstimate = vField 
Call udtFile.ReadField(vField) 
IsRouted = vField 
Call udtFile.ReadField(vField) 
IsDifficultyCalculated = vField 
Set mudtDE = Nothing 
If IsDifficultyCalculated Then 
Select Case Program 
Case prGRE 

Set mudtDE = New GREDifficultyEstimate 
Case prGMAT 

Set mudtDE = New GMATDifficultyEstimate 
End Select 

Call mudtDE.ReadObj ectData(udtFile) 
End If 



End Sub 



Public Sub WriteObjectData(udtFile As File) 



Call udtFile.WriteField(mintVERSIONSTAMP) 

Call udtFile.WriteField(ExtractFileName(mstrFN)) 

Call udtFile.WriteField(Key) 

Call udtFile.WriteField(ItemType) 

Call udtFile.WriteField(Program) 

Call udtFile.WriteField(Domain) 

Call udtFiIe.WriteField(BatchID) 

CalludtFile.WriteField(DehveryMode) 

Call udtFile.WriteField(Nature) 

CalludtFile.WriteField(TDEstimate) 

Call udtFile.WriteField(IsRouted) 

CalludtFile.WriteField(IsDifficultyCalculated) 

If IsDifficultyCalculated Then 

Call mudtDE. WriteObj ectData(udtFile) 
End If 



mblnlsDirty = False 



End Sub 
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' CModels.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l True 
END 

Attribute VB_Name - "CModels" 
Attribute VB_GlobalNameSpace = False 
Attribute VB__Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

'to hold collection 

Private mcolModels As Collection 

Private Sub Class_Initialize() 

'creates the collection when this class is created 
Set mcolModels = New Collection 

End Sub 

Private Sub Class_Terminate() 

'destroys collection when this class is terminated 
Set mcolModels = Nothing 

End Sub 

Public Property Get Item(vntIndexKey As Variant) As Model 

'used when referencing an element in the collection 

'vntlndexKey contains either the Index or Key to the collection, 

'this is why it is declared as a Variant 

'Syntax: Set foo = x Jtem(xyz) or Set foo = x.Item(5) 

Set Item = mcolModels(vntlndexKey) 

End Property 

Public Property Get Count() As Long 

'used when retrieving the number of elements in the 
'collection. Syntax: Debug.Print x, Count 
Count = mcolModels.Count 
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End Property 

Public Sub AddObject(udtMod As Model) 

' adds model objects directly to the collection. Use the file 
'key. 

Call mcolModels.Add(udtMod, Str(udtMod.FileName)) 
End Sub 

Public Function AddNew(ByVal strFN As String, _ 
ByVal udtltemType As ItemType) As Model 

Dim udtMod As Model 
Dim udtSMC As SMCModel 
Dim udtQC As QCModel 
Dim udtDS As DSModel 

Select Case udtltemType 

Case ptStandardMC 

Set udtSMC = New SMCModel 
Set udtMod = udtSMC 

Case ptQuantComp 
Set udtQC = New QCModel 
Set udtMod = udtQC 

Case ptDataSuff 

Set udtDS = New DSModel 
Set udtMod = udtDS 

End Select 

' file name has fixU path 
udtMod-FileName = strFN 
udtMod-IsFrozen = False 

' strip path fi-om key 

Call mcolModels.Add(udtMod, ExtractFileName(strFN)) 
Set AddNew = udtMod 
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End Function 



Public Function AddExisting(ByVal strFN As String, _ 
ByVal udtltemType As ItemType) As Model 

Dim udtMod As New Model 
Dim udtSMC As SMCModel 
Dim udtQC As QCModel 
Dim udtDS As DSModel 

Select Case udtltemType 

Case ptStandardMC 

Set udtSMC = New SMCModel 
Set udtMod - udtSMC 

Case ptQuantComp 

Set udtQC = New QCModel 
Set udtMod = udtQC 

Case ptDataSuff 

Set udtDS = New DSModel 
Set udtMod -udtDS 

End Select 

' file name has full path 
udtMod.FileName - strFN 
Call udtMod.ReadModel 

' strip path from key 

Call mcolModels. Add(udtMod, ExtractFileName(strFN)) 
Set AddExisting = udtMod 
End Function 

Public Sub Remove(vntIndexKey As Variant) 

'used when removing an element from the collection 
VntlndexKey contains either the Index or Key, which is why 
'it is declared as a Variant 
'Syntax: x.Remove(xyz) 
mcolModels.Remove vntlndexKey 

End Sub 
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Public Property Get NewEnum() As lUnknown 
Attribute NewEnum.VB_UserMemId = -4 
Attribute NewEnum. VB_MemberFlags = "40" 

'this property allows you to enumerate 
'this collection with the For... Each syntax 
Set NewEnum = mcolModels.[_NewEnum] 

End Property 

Public Sub ClearQ 

' empties the collection class 

Set mcolModels = Nothing 

Set mcolModels = New Collection 



End Sub 



' Constraintxls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse-0 'False 

Persistable = 0 'NotPersistable 

DataBindingBehavior = 0 'vbNone 

DataSourceBehavior VbNone 

MTSTransactionMode - 0 'NotAnMTSObject 
END 

Attribute VB_Name = "Constraint" 
Attribute VB_GlobalNameSpace ^ False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB__Exposed = False 

Attribute VB__Ext_KEY = "SavedWithClassBuilder" /'Yes" 
Attribute VB_Ext_KEY = "MemberO" /'CloningConstraint" 
Attribute VB_Ext_KEY = "Memberl" /'DifficultyConstraint" 
Attribute VB_Ext_KEY - "Member2" ,"MathConstraint" 
Attribute VB_Ext_KEY = "MemberS" ."VariableDefmition" 
Attribute VB_Ext_KEY = "Top^Level" ,"Yes" 
Option Explicit 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer = 1 

Private mudtType As VariableType 
Private mstrConstraint As String 
Private mstrComment As String 
Private mlnglndex As Long 
Private mblnEnabled As Boolean 
Private mblnlsDirty As Boolean 

' These numbers correspond to the indices of the constraint listboxes 
Pubhc Enum ConstraintType 

ctVariation = 0 

ctDistractor = 1 
End Enum 

Pubhc Property Get ConstraintString() As String 

ConstraintString = mstrConstraint 
End Property 
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Public Property Let ConstraintString(ByVal strNewValue As String) 

If mstrConstraint <> strNewValue Then 

mstrConstraint = strNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get Comment() As String 

Comment = mstrComment 
End Property 

Public Property Let Comment(ByVal strNewValue As String) 

If mstrComment o strNewValue Then 

mstrComment = strNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get ConstraintType() As ConstraintType 

ConstraintType = mudtType 
End Property 

PubUc Property Let ConstraintType(ByVal udtNewValue As ConstraintType) 

If mudtType <> udtNewValue Then 

mudtType = udtNewValue 

mblnlsDirty ^ True 
End If 

End Property 

Public Property Get index() As Long 

index = mlnglndex 
End Property 
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Public Property Let index(ByVal IngNewValue As Long) 

mlnglndex = IngNewValue 
End Property 

Public Property Get EnabledQ As Boolean 

Enabled = mblnEnabled 
End Property 

Public Property Let Enabled(ByVal blnNewValue As Boolean) 

If mblnEnabled o blnNewValue Then 

mblnEnabled = blnNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Let IsDirty(ByVal blnNewValue As Boolean) 

mblnlsDirty ^ blnNewValue 
End Property 

Public Property Get IsDirtyQ As Boolean 

IsDirty = mblnlsDirty 
End Property 

Public Sub Update(ByVal strConstraint As String, ByVal udtType As ConstraintType, 
ByVal strComment As String) 

ConstraintString = strConstraint 
ConstraintType = udtType 
Comment = strComment 

End Sub 

Public Sub ReadObjectData(udtFile As File) 
Dim vField As Variant 
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Call udtFile.ReadField(vField) ' read version stamp 
Call udtFile.ReadField(vField) 
ConstraintType = vField 

Call udtFile.ReadField(vField) 
Enabled = vField 

Call udtFile.ReadField(vField) 
ConstraintString = vField 

Call udtFile.ReadField(vField) 
Comment = vField 

End Sub 

Public Sub WriteObjectData(udtFile As File) 

CalludtFile.WriteField(mintVERSIONSTAMP) 
Call udtFile.WriteField(ConstraintType) 
Call udtFile.WriteField(Enabled) 
CalludtFile.WriteField(ConstraintString) 
Call udtFile.WriteField(Comment) 

mblnlsDirty = False 

End Sub 

' makes a copy of this object 

Public Function Copy() As Constraint 

Dim udtC As New Constraint 

udtC.Enabled = Enabled 
udtC.index = index 
udtC .IsDirty = IsDirty 
udtC.ConstraintType = ConstraintType 
udtC.ConstraintString = ConstraintString 
udtC.Comment = Comment 

Set Copy = udtC 

End Function 
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' ConstraintSolverxls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse--! True 

Persistable = 0 'NotPersistable 

DataBindingBehavior = 0 'vbNone 

DataSourceBehavior =0 'vbNone 

MTSTransactionMode =0 'Not AnMTS Object 
END 

Attribute VB_Name - "ConstraintSolver" 
Attribute VB__GlobalNameSpace False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed ^ False 
Option Explicit 

Private mcolVs As Collection 
Private mcolVsSave As Collection 
Private mcolCs As Collection 
Private mcolCsSave As Collection 
Private mcolValues As Collection 
Private mbytDiffWeight As Byte 
Private mdblChecksum As Double 
Private mintlndex As Integer 

Private WithEvents mwudtP As Prolog 
Attribute mwudtP.VB_VarHelpID = -1 
Private mlngRet As Long 

Private mblnProloglsRunning As Boolean 

Public Enum SolveRequester 

srTest = 0 

srGenerate = 1 
End Enum 

Public Enum SolveRetum 

srNo Solutions = 0 

srSuccess = 1 

srPrologAborted = -1 

srPrologError = -2 
End Enum 

Private mudtSolveRequester As SolveRequester 
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Private Sub Class_Initialize() 

Set mcolVs = New Collection 
Set mcolVsSave = New Collection 
Set mcolCs = New Collection 
Set mcolCsSave ^ New Collection 
Set mcolValues = New Collection 

End Sub 

Private Sub Class_Terminate() 

' Kill Prolog 

Set mwudtP = Nothing 

End Sub 

Public Property Let Prolog(ByVal udtNewValue As Prolog) 

Set mwudtP = udtNewValue 
End Property 

Public Property Let DiffWeight(ByVal bytNewValue As Byte) 

mbytDiffWeight = bytNewValue 
End Property 

Public Sub AddVariable(ByVal udtNewValue As Variable) 

If udtNewValue.Enabled Then 

Call mcolVs.Add(udtNewValue.Copy) ' uses a copy of the variable 

Call mcolVsSave.Add(udtNewValue.Copy) 
End If 

End Sub 

Public Sub AddConstraint(ByVal udtNewValue As Constraint) 

If udtNewValue.Enabled Then 

Call mcolCs.Add(udtNewValue.Copy) ' uses a copy of the constraint 

Call mcolCsSave.Add(udtNewValue.Copy) ' 
End If 
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End Sub 



Public Function GetNextValue(strVarName As String, _ 
strValue As String) As Boolean 

Dim udtVal As Value 

If mintlndex <= mcolValues.Count Then 
Set udtVal = mcolValues.Item(mintlndex) 
strVarName = udtVal. VariableName 
StrValue = udtVal.Value 

' if the value is ^, replace with so Word doesn't choke 
If StrValue - Then strValue = 
mintlndex = mintlndex + 1 
GetNextValue ^ True 
Else 

GetNextValue ^ False 
End If 

End Function 

Public Sub ResetValuelndexO 

mintlndex = 1 
End Sub 

Public Property Get Checksum() 
Checksum = mdblChecksum 
End Property 

Pubhc Function Solve(ByVal udtSolveRequester As SolveRequester) As SolveRetum 

Dim udtVal As Value 
Dim udtC As Constraint 
Dim udtV As Variable 
Dim udtVS As VarString 
Dim udtSS As StringSolver 

mudtSolveRequester = udtSolveRequester 

Set mcolValues = New Collection 
mintlndex = 1 
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CreateValueCoUection 

If mcolValues.Count = 0 Then 

Solve = srNoSolutions 

Exit Function 
End If 

' solve all string variables 
For Each udtV In mcolVs 
If udtV.Typ - vtString Then 
Set udtVS = udtV 

' if this variable has no strings, error 

If udtVS.StringCoUection.Count = 0 Then 

Solve = srNoSolutions 

Exit Function 
End If 

Set udtSS = New StringSolver 
udtSS.StringVariable = udtVS 
Call LoadStringValues(udtVS, udtSS) 
End If 
Next udtV 

' resolve any nested values for all string variable names 
ResolveNestedStrings 

' resolve string variable names embedded in math variable ranges 
ResolveStringsInMathVariables 

' resolve string variable names embedded in constraints 
ResolveConstraints 

' set the difference weight (difference between variants) 
mwudtP.DiffWeight = mbytDiffWeight 

Dim blnMathToSolve As Boolean 

' add non-string variables to prolog via the value object collection 
For Each udtVal In mcolValues 

If Not udtVal.VariableType = vtString Then 
CallmwudtP.AddVariable(udtVaLPrologString) 

blnMathToSolve = True 
End If 
Next udtVal 
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' add all constraints 

For Each udtC In mcolCs 

CallmwudtP.AddConstraint(udtC.ConstraintString) 

blnMathToSolve = True 
Next udtC 

' call prolog if there are math constraints, error if no solution found 
If blnMathToSolve Then 

' get rid of the kill file if it exists 

DestroyKillFile 

mblnProloglsRunning = True 

' runs async, notifies this class when it's done via the Finished event 

mwudtP.SolveConstraintsRandomly 

If udtSolveRequester = srTest Then 

frmProlog.Caption = "Testing constraints" 

frmProlog.lblProlog.Caption == "Click Abort to terminate this test." 

frmProlog.Show vbModal 
Else 

Do 

DoEvents 

Loop While mblnProloglsRunning 
End If 

If frmProlog. Abort Then 

' create the kill file 

CreateKillFile 

Solve = srPrologAborted 

Exit Function 
End If 
' not aborted 
Select Case mlngRet 

Case Is < 0 

Solve = srPrologError 

Call MsgBox("Prolog error: " & Str(mlngRet), vbExclamation, "Error") 
Exit Function 
Case 0 

Solve = srNoSolutions 
Exit Function 
End Select 
End If 

' load up values from Prolog 
For Each udtVal In mcolValues 

If Not udtVal.VariableType = vtString Then 

udtVal. Value = mwudtP.Value(udtVal.VariableName) 

End If 
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Next udtVal 

' resolve string values that are math variable names 
ResoIveMathVariablesInStrings 

Dim udtChecksum As New Checksum 

' compute the checksum of values 
For Each udtVal In mcolValues 
If udtVal Checksum Then 

Call udtChecksum.AddValue(udtVaLValue) 

End If 
Next udtVal 

mdblChecksum = udtChecksum, ComputeCS 
Solve = srSuccess 

' restore the variable and constraint collections their original states, 
' as substitutions may have contaminated them. 
Set mcolVs = New Collection 
Set mcolCs = New Collection 

For Each udtV In mcolVsSave 

Call mcolVs.Add(udtV.Copy) 
Next udtV 

For Each udtC In mcolCsSave 

Call mcolCs.Add(udtC.Copy) 
Next udtC 

End Function 

' this event raised in Prolog class 

Private Sub mwudtP_Finished(ByVal IngRet As Long) 

mblnProloglsRunning = False 
mlngRet = IngRet 

' kill the form if this is a test 

If mudtSolveRequester = srTest Then 

frmProlog,Kill 
End If 

End Sub 
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Private Sub CreateValueCoUectionQ 



Dim inti As Integer 
Dim udtV As Variable 
Dim udtVS As VarString 
Dim udtVal As Value 

For Each udtV In mcolVs 
If udtV.Typ = vtString Then 
Set udtVS = udtV 
If udtVS.IsIndexed Then 
For intI = udtVS.Numlndices To 1 Step -1 
Set udtVal = New Value 

udtValVariableName = GetIndexedName(udtV.name, 
udtVal VariableType - udtV.Typ 
udtVal.Checksum = udtV.Checksum 
udtVal.PrologString = udtV.PrologFormat 
Call mcolValues.Add(udtVal, udtValVariableName) 
Next intI 
Else 

Set udtVal = New Value 
UdtValVariableName ^ udtV.name 
udtVal VariableType = udtV.Typ 
udtVal Checksum = udtV.Checksum 
udtVal.PrologString = udtV.PrologFormat 
Call mcolValues.Add(udtVal, udtValVariableName) 
End If 
Else 

Set udtVal = New Value 
udtValVariableName = udtV.name 
udtValVariableType = udtV.Typ 
udtVal.Checksum = udtV.Checksum 
udtVal.PrologString = udtV.PrologFormat 
Call mcolValues.Add(udtVal udtValVariableName) 
End If 
Next udtV 

End Sub 

Private Sub LoadStringValues(ByVal udtV As Variable, _ 
ByVal udtSS As StringSolver) 

Dim intI As Integer 
Dim varS As Variant 
Dim strVN As String 
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Dim udtVal As Value 
Dim udtVS As VarString 

Set udtVS = udtV 

' get the value or values (if indexed) 
If udtVS.IsIndexed Then 
inti - 1 

For Each varS In udtSS.RandomValueCollection 

strVN = GetIndexedName(udtV.name, intI) 

Set udtVal = mcolValues.Item(strVN) 

udtValValue = varS 

intI = intI + 1 
Next varS 
Else 

Set udtVal = mcolValues Jtem(udtV.name) 
udtVal.Value = udtSS.RandomValueCollection(l) 
End If 

End Sub 

Private Sub ResolveNestedStrings() 

Dim blnContinue As Boolean 
Dim udtVal As Value 

Do 

blnContinue = False 

For Each udtVal In mcolValues 

If udtVal. VariableType = vtString Then 

If ResolveString(udtVal. VariableName) Then 

blnContinue ^ True 
End If 
End If 
Next udtVal 
Loop Until blnContinue = False 

End Sub 

Private Function ResolveString(ByVal strVN As String) As Boolean 

Dim udtVal As Value 
Dim udtVal2 As Value 
Dim strT As String 
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ResolveString = False 

For Each udtVal In mcolValues 

If udtVal.VariableType = vtString Then 
5 Set udtVal2 = mcolValues.Item(strVN) 

strT = ReplaceAll(udtVal.Value, strVN, udtVal2.Value) 
If strT <> udtVal.Value Then 
udtVal. Value = strT 
ResolveString = Trae 
10 End If 

End If 
Next udtVal 

End Function 

15 Private Sub ResolveStringsInMathVariablesQ 

Dim udtVal As Value 
pi Dim udtVal2 As Value 

01 For Each udtVal In mcolValues 
201 If udtVal.VariableType = vtString Then 

4;; For Each udtVal2 In mcolVakies 

jj If Not udtVal2. VariableType = vtString Then 

4=; udtVal2.PrologString = Replace All(udtVal2.PrologString, 

udfVal.VariableName, udtVal.Value) 

21. End If 

Next udtVal2 
I; End If 

y| Next udtVal 

3ii End Sub 

Private Sub ResolveConstraintsQ 

Dim udtC As Constraint 
Dim udtVal As Value 

35 For Each udtVal In mcolValues 

If udtVal. VariableType = vtString Then 
For Each udtC In mcolCs 

udtC.ConstraintString = ReplaceAll(udtC.ConstraintString, _ 
udtVal.VariableName, udtVal.Value) 
Next udtC 
End If 
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Next udtVal 



End Sub 

Private Sub ResolveMathVariablesInStringsQ 

Dim udtVal As Value 
Dim udtVal2 As Value 

For Each udtVal In mcolValues 

If udtVal. VariableType = vtString Then 
For Each udtVal2 In mcolValues 

If Not udtVal2.VariableType = vtString Then 
udtVal.Value = ReplaceAll(udtVal.Value, udtVal2.VariableName, 
udtVal2.Value) 
End If 
Next udtVal2 
End If 
Next udtVal 

End Sub 



' CVariables.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l 'True 
END 

Attribute VB_Name = "CVariables" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 

Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes" 
Attribute VB_Ext_KEY = "Collection" /'Variable" 
Attribute VB_Ext_KEY = "MemberO" /'Variable" 
Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 
Option Explicit 

' enable i/o 

Private mudtFile As File 
'to hold collection 

Private mcolVariable As Collection 
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' is dirty 

Private mblnlsDirty As Boolean 

Public Property Let IsDirty(ByVal blnNewValue As Boolean) 

mblnlsDirty = blnNewValue 
End Property 

Public Property Get IsDirtyQ As Boolean 

Dim udtVar As Variable 

For Each udtVar In mcolVariable 
If udtVar.IsDirty Then 
mblnlsDirty = True 
Exit For 
End If 
Next udtVar 

IsDirty = mblnlsDirty 

End Property 

Private Sub Class__Initialize() 

'creates the collection when this class is created 
Set mcolVariable = New Collection 

Set mudtFile New File 

End Sub 

Private Sub Class_Terminate() 

'destroys collection when this class is terminated 
Set mcolVariable = Nothing 

'destroys the File object 
Set mudtFile = Nothing 

End Sub 

Public Property Get Item(vntIndexKey As Variant) As Variable 
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'used when referencing an element in the collection 

'vntlndexKey contains either the Index or Key to the collection, 

'this is why it is declared as a Variant 

'Syntax: Set foo - x Jtem(xyz) or Set foo = x.Item(5) 

Set Item = mcolVariable(vntlndexKey) 

End Property 

Public Property Get CountQ As Long 

*used when retrieving the number of elements in the 
'collection. Syntax: Debug.Print x.Count 
Count = mcolVariable.Count 

End Property 

Public Sub AddObject(udtVar As Variable) 
' adds variable objects directly to the collection 
udtVar index = NextID 

Call mcolVariable. Add(udtVar, Str(udtVar,Index)) 
End Sub 

PubUc Function AddInteger(ByVal strName As String, ByVal blnEnabled As Boolean, _ 
ByVal strFrom As String, ByVal strTo As String, ByVal strBy As String, _ 
ByVal blnlslndependent As Boolean, ByVal blnChecksum As Boolean) As Variable 

'create a new object 

Dim udtVar As Variable 

Dim udtVarlnteger As New Varlnteger 

Set udtVar = udtVarlnteger 

'set the properties passed into the method 
With udtVar 

.Typ = vtlnteger 

.Name = strName 

.Enabled = blnEnabled 

.Index = NextID 

.Checksum = blnChecksum 
End With 

With udtVarlnteger 
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.From = strFrom 
.Too = strTo 
.By = strBy 

.Islndependent = blnlslndependent 
End With 

' add the new object to the collection 

Call mcolVariable.Add(udtVarInteger, Str(udtVar.Index)) 

'return the object created 

Set Addlnteger ^ udtVarlnteger 

End Function 

Public Function AddReal(ByVal strName As String, ByVal blnEnabled As Boolean, 
ByVal StrFrom As String, ByVal strTo As String, ByVal strBy As String, _ 
ByVal blnlslndependent As Boolean, ByVal blnChecksum As Boolean, _ 
ByVal blnTrailingZeros As Boolean, _ 

ByVal strPrecision As String, ByVal blnOnGrid As Boolean) As Variable 

'create a new object 

Dim udtVar As Variable 

Dim udtVarReal As New VarReal 

Set udtVar - udtVarReal 

'set the properties passed into the method 
With udtVar 

.Typ = vtReal 

.Name = strName 

.Enabled = blnEnabled 

index = NextID 

.Checksum = blnChecksum 
End With 

With udtVarReal 
.From ^ StrFrom 
.Too = StrTo 
.By = StrBy 

.Islndependent = blnlslndependent 
.TrailingZeros = blnTrailingZeros 
.Precision = strPrecision 
.IsOnGrid - blnOnOrid 
End With 
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' add the new object to the collection 

Call mcolVariable.Add(udtVarReal, Str(udtVar index)) 

'return the object created 
Set AddReal - udtVarReal 

5 End Function 

Public Function AddFraction(ByVal strName As String, ByVal blnEnabled As Boolean, _ 
ByVal strFromNum As String, ByVal strFromDen As String, _ 
ByVal strToNum As String, ByVal strToDen As String, _ 
ByVal strByNum As String, ByVal strByDen As String, _ 
1 0 ByVal blnlslndependent As Boolean, ByVal blnChecksum As Boolean, _ 

ByVal blnMixedNumbers As Boolean) As Variable 

'create a new object 
Dim udtVar As Variable 
1 5 Dim udtVarFraction As New VarFraction 

4 : S et udtVar udtVarFraction 

ijl 'set the properties passed into the method 

4;; With udtVar 

.Typ = vtFraction 

.Name = strName 

.Enabled = blnEnabled 
'l^, .Index = NextID 

. Checksum = blnChecksum 
2I:? End With 

1 With udtVarFraction 

cj .FromNumerator = strFromNum 

.FromDenominator = strFromDen 
30 .ToNumerator = strToNum 

.ToDenominator = strToDen 
.ByNumerator = strByNum 
.ByDenominator = strByDen 
.Islndependent = blnlslndependent 
3 5 .MixedNumbers - blnMixedNumbers 

End With 

' add the new object to the collection 

Call mcolVariable.Add(udtVarFraction, Str(udtVar.Index)) 

40 'return the object created 
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Set AddFraction udtVarFraction 
End Function 

Public Function AddString(ByVal strName As String, ByVal blnEnabled As Boolean, _ 
ByVal blnChecksum As Boolean, ByVal strDelimiter As String, _ 
ByVal blnlslndexed As Boolean, ByVal colString As Collection) As Variable 

'create anew object 

Dim udtVar As Variable 

Dim udtVarString As New VarString 

Set udtVar = udtVarString 

'set the properties passed into the method 
With udtVar 

.Typ = vtString 

.Name = strName 

.Enabled = blnEnabled 

.Index = NextID 

.Checksum = blnChecksum 
End With 

udtVarString.Delimiter = strDelimiter 
udtVarString. StringCoUection = colString 
udtVarString.IsIndexed = blnlslndexed 

' add the new object to the collection 

Call mcolVariable, Add(udtVarString, Str(udtVar.Index)) 

'return the object created 

Set AddString = udtVarString 

End Function 

Public Function AddUntyped(ByVal strName As String, ByVal blnEnabled As Boolean, 
ByVal blnChecksum As Boolean) 

'create a new object 

Dim udtVar As Variable 

Dim udtVarUntyped As New VarUntyped 

Set udtVar = udtVarUntyped 

'set the properties passed into the method 
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With udtVar 

.Typ = vtUntyped 

.Name = strName 

.Enabled = blnEnabled 

.Index = NextID 

.Checksum ^ blnChecksum 
End With 

' add the new object to the collection 

Call mcolVariable.Add(udtVarUntyped, Str(udtVar.Index)) 

'return the object created 

Set AddUntyped = udtVarUntyped 

End Function 

Public Sub Remove(vntIndexKey As Variant) 

'used when removing an element from the collection 
VntlndexKey contains either the Index or Key, which is why 
'it is declared as a Variant 
'Syntax: x.Remove(xyz) 
mcolVariable.Remove vntlndexKey 

mblnlsDirty ^ True 

End Sub 



Public Property Get NewEnumQ As lUnknown 
Attribute NewEnum.VB_UserMemId = -4 
Attribute NewEnum.VB_MemberFlags = "40" 

'this property allows you to enumerate 
'this collection with the For... Each syntax 
Set NewEnum = mcolVariable.[_NewEnum] 

End Property 

Private Function NextID() As Long 

' creates a unique index to associate a variable and the variable hstbox 
Static InglD As Long 



InglD - InglD + 1 
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NextID - InglD 
End Function 

' returns true if strName is already a variable name in the collection. If the 
' optional parameter is used, the function will not check that variable for a dup. 

Public Function UniqueName(ByVal strName As String, _ 
Optional ByVal bytSkipThisVar As Byte = 0, _ 
Optional ByVal udtSkipVar As Variable) As Boolean 

Dim udtVar As Variable 

UniqueName = True 

' Check for duplicate variable name 
For Each udtVar In mcolVariable 

If UCase(strName) - UCase(udtVar.Name) Then 
If bytSkipThisVar - 1 Then 

If udtSkipVar.Index <> udtVar, Index Then 
UniqueName ^ False 
Exit For 
End If 
Else 

UniqueName False 
Exit For 
End If 
End If 

Next udtVar 

End Function 

• Check enabled variables in collection for duplicate names. 

Public Function DupUcateNamesQ As Boolean 

Dim udtVarl As Variable 
Dim udtVar2 As Variable 
Dim intll As Integer 
Dim intI2 As Integer 

DuplicateNames = False 
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For intll = 1 To mcolVariable.Count 
For intI2 = 1 To mcolVariable.Count 
If intll <> intI2 Then 

Set udtVarl = mcolVariable,Item(intIl) 
Set udtVar2 = mcolVariable.Item(intI2) 
If udtVarhEnabled And udtVar2,Enabled Then 
If udtVarl .Name = udtVar2.Name Then 
DuplicateNames = True 
Exit Function 
End If 
End If 
End If 
Next intI2 
Next intll 

End Function 

Public Sub ReadCollection(ByVal strFN As String, ByVal IngStartlndex As 
By Val IngEndlndex As Long) 

mudtFile.FileName = strFN 

Call mudtFile.ReadFile(Me, IngStartlndex, IngEndlndex) 
End Sub 

Public Sub ReadObjectsO 

Dim udtVar As Variable 
Dim udtType As VariableType 

On Error GoTo Beatit 

Do Until Err.Number <> 0 

Set udtVar = New Variable 

udtType = udtVar.ReadType(mudtFile) 

Select Case udtType 
Case vtlnteger 

Set udtVar = New Varlnteger 

udtVar.Typ = vtlnteger 
Case vtReal 

Set udtVar = New VarReal 

udtVar.Typ - vtReal 
Case vtFraction 
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Set udtVar = New VarFraction 

udtVar.Typ = vtFraction 
Case vtString 

Set udtVar = New VarString 

udtVar.Typ = vtString 
Case vtUntyped 

Set udtVar = New VarUntyped 

udtVar.Typ - vtUntyped 
End Select 

Call udt Var.ReadObj ectData(mudtFile) 
udtVar.Index = NextID 

Call mcolVariable.Add(udtVar, Str(udtVar.Index)) 
Loop 

Beatit: 

Exit Sub 

End Sub 

Public Function WriteCollection(ByVal strFN As String, _ 
ByVal InglndexPos As Long, ByVal IngSeekPos) As Long 

mudtFile.FileName = strFN 

WriteCollection = mudtFile,WriteFile(Me, False, InglndexPos, IngSeekPos) 

mblnlsDirty = False 
End Function 
Public Sub WriteObjectsO 

Dim udtVar As Variable 

For Each udtVar In mcolVariable 

Call udt Var. WriteObj ectData(mudtFile) 
Next udtVar 

End Sub 

Public Sub ClearO 

' empties the collection class 
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Set mcolVariable = Nothing 

Set mcolVariable = New Collection 

End Sub 

' returns a collection of variables sorted by length of variable 
' longest to shortest 

Public Function SortVarNamesByLengthQ As CVariables 

Dim udtVar As Variable 

Dim intLen As Integer 

Dim intLongest As Integer 

Dim udtCVar As New CVariables 

' Find longest variable name 
For Each udtVar In mcolVariable 
IfudtVar.Enabled Then 
intLen ^ Len(udtVar.Name) 
If intLen > intLongest Then 

intLongest = intLen 
End If 
End If 
Next udtVar 

' Sort variables by length of name - longest first 
Do 

For Each udtVar In mcolVariable 
IfudtVar.Enabled Then 

intLen = Len(udtVar.Name) 
If intLen = intLongest Then 
' Put this var in sorted collection 
udtCVar.AddObject udtVar 
End If 
End If 
Next udtVar 

intLongest = intLongest - 1 
Loop While intLongest > 0 

Set SortVarNamesByLength = udtCVar 
End Function 
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' CVariants.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse--! 'True 
END 

Attribute VB_Name = "CVariants" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = Trae 
Attribute VB_PredeclaredId False 
Attribute VB_Exposed False 
Option Explicit 

'to hold collection 

Private mcolVariants As Collection 

Private Sub Class_Initialize() 

'creates the collection when this class is created 
Set mcolVariant ^ New Collection 

End Sub 



Private Sub Class_Terminate() 

'destroys collection when this class is terminated 
Set mcolVariant = Nothing 

End Sub 

Public Property Get Item(vntIndexKey As Variant) As Variant 

'used when referencing an element in the collection 

'vntlndexKey contains either the Index or Key to the collection, 

'this is why it is declared as a Variant 

'Syntax: Set foo = x.Item(xyz) or Set foo - x.Item(5) 

Set Item = mcolVariant(vntlndexKey) 

End Property 

Public Property Get Count() As Long 
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'used when retrieving the number of elements in the 
'collection. Syntax: Debug.Print x.Count 
Count =^ mcolVariant.Count 

End Property 

Public Sub AddObject(udtVar As Variant) 
' adds variable objects directly to the collection 
udtVar.Index = NextID 

Call mcolVariant .Add(udtVar, Str(udtVar.Index)) 
End Sub 

Public Function Add(ByVal strName As String, _ 

By Val strFrom As String, ByVal strTo As String, ByVal strBy As String) As Variant 

'create anew object 

Dim udtVar As Variant 

Dim udtVarlnteger As New Varlnteger 

Set udtVar ^ udtVarlnteger 

'set the properties passed into the method 
With udtVar 

.Name = strName 

.Index = NextID 
End With 

With udtVarlnteger 

.From = strFrom 

.Too = strTo 

.By = StrBy 
End With 

' add the new object to the collection 

Call mcolVariant.Add(udtVarInteger, Str(udtVar.Index)) 

'return the object created 

Set Addlnteger = udtVarlnteger 

End Function 
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Public Sub Remove(vntIndexKey As Variant) 

'used when removing an element from the collection 
VntlndexKey contains either the Index or Key, which is why 
'it is declared as a Variant 
'Syntax: x.Remove(xyz) 
mcolVariant.Remove vntlndexKey 

End Sub 



Public Property Get NewEnum() As lUnknown 

'this property allows you to enumerate 
'this collection with the For... Each syntax 
Set NewEnum = mcolVariant.[_NewEnum] 

End Property 

Private Function NextlDQ As Long 

' creates a unique index to associate a variable and the variable listbox 
Static InglD As Long 

InglD - InglD + 1 
NextID = InglD 

End Function 

Public Sub ClearO 

' empties the collection class 

Set mcol Variant = Nothing 

Set mcol Variant = New Collection 

End Sub 
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' DifficultyEstimate.cls 
VERSION 1.0 CLASS 
BEGIN 
MultiUse--! 'True 
END 

Attribute VB_Name = "DifficultyEstimate" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId False 
Attribute VB_Exposed = False 
Option Explicit 

Private mblnlsDirty As Boolean 
Private Sub Class_Initialize() 

mblnlsDirty = False 
End Sub 

Public Property Let IsDirty(ByVal blnNewValue As Boolean) 

mblnlsDirty ^ bbiNewValue 
End Property 

Public Property Get IsDirtyQ As Boolean 

IsDirty = mblnlsDirty 
End Property 

' implemented in the subclasses of DifficultyEstimate 
Public Function ComputeDifficulty() As Double 

End Function 

' implemented in the subclasses of DifficultyEstimate 
Public Function CopyQ As DifficultyEstimate 

End Function 

' implemented in the subclasses of DifficultyEstimate 
Public Sub ReadObjectData(udtFile As File) 
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End Sub 

' implemented in the subclasses of DifficultyEstimate 
Public Sub WriteObjectData(udtFile As File) 

End Sub 
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' DocStatus.cls 
VERSION LO CLASS 
BEGIN 
MultiUse = -l True 
END 

Attribute VB_Name = "DocStatus" 
Attribute VB_GlobalNanieSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed === False 
Option Explicit 

' returns true if this document strFN is open 

Public Function IsOpen(ByVal strFN As String) As Boolean 

Dim docD As Document 

For Each docD In Documents 

If InStr(l, StrFN, docD.Name) Then 
IsOpen = True 
Exit Function 
End If 
Next docD 

IsOpen = False 

End Function 
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' DSMODEL.CLS 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l 'True 

Persistable = 0 'NotPersistable 

DataBindingBehavior = 0 VbNone 

DataSourceBehavior = 0 VbNone 

MTSTransactionMode = 0 'NotAnMTSObject 
END 

Attribute VB_Name = "DSModel" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId ^ False 
Attribute VB_Exposed = False 
Option Explicit 

Implements Model 

Dim mudtModel As Model 

Private Sub Class_Initialize() 

Set mudtModel = New Model 

End Sub 

' Delegated to Class Model 

Public Property Get Model__FileName() As String 

Model_FileName = mudtModel.FileName 

End Property 

' Delegated to Class Model 

Public Property Let Model_FileName(ByVal strNewValue As String) 

mudtModel.FileName strNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_IsFrozen() As Boolean 
Model IsFrozen = mudtModel.IsFrozen 
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End Property 

' Delegated to Class Model 

Public Property Let Model__IsFrozen(ByVal blnNewValue As Boolean) 

mudtModellsFrozen = blnNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_Comments() As String 

Model_Comments = mudtModel. Comments 
End Property 

' Delegated to Class Model 

Public Property Let Model_Comments(ByVal strNew Value As String) 

mudtModel.Comments = strNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_Clones() As CClones 

Set Model_Clones = mudtModel. Clones 

End Property 

' Delegated to Class Model 

Public Property Get Model_Variables() As CVariables 

Set Model_Variables = mudtModel.Variables 
End Property 

' Delegated to Class Model 

Public Property Get Model_Constraints() As CConstraints 

Set Model_Constraints ^ mudtModel. Constraints 
End Property 
'Delegated to Class Model 

VBSCA -315- 



Public Sub Model_AddChecksum(ByVal dblChecksum As Double) 

Call mudtModelAddChecksum(dblChecksum) 
End Sub 

' Delegated to Class Model 

Public Sub Model_InitChecksums() 

mudtModellnitChecksums 

End Sub 

' Delegated to Class Model 

Public Sub Model_InitTempChecksums() 

mudtModel . InitTemp Checksums 

End Sub 

'Delegated to Class Model 

Public Function Model_ChecksumExists(ByVal dblChecksum As Double) As Boolean 

Model_ChecksumExists = mudtModeLChecksumExists(dblChecksum) 
End Function 
' Delegated to Class Model 

Public Property Let Model_IsDirty(ByVal blnNewValue As Boolean) 

mudtModel JsDirty = blnNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_IsDirty() As Boolean 

Model__IsDirty = mudtModel.IsDirty 

End Property 

' Delegated to Class Model 

Public Property Let Model_LastClone(ByVal intNewValue As Integer) 
mudtModel.LastClone = intNewValue 
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End Property 

' Delegated to Class Model 

Public Property Get Model_LastClone() As Integer 

Model_LastClone = mudtModel.LastClone 
End Property 

' Delegated to Class Model 
Public Sub Model_FreezeModel() 

Call mudtModel.FreezeModel 

End Sub 

' Delegated to Class Model 

Public Sub Model__OpenDoc(ByVal udtWord As MSWord) 

Call mudtModeLOpenDoc(udtWord) 
End Sub 

' Delegated to Class Model 
Public Sub ModeLCloseDocO 

Call mudtModel.CloseDoc 

End Sub 

' Delegated to Class Model 

Public Sub Model_CloseAllCloneDocs() 

Call mudtModel.CloseAUCloneDocs 

End Sub 

' Delegated to Class Model 
Public Sub Model_ReadModel() 

mudtModelReadModel 

End Sub 

' Delegated to Class Model 
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Public Sub Model_ReadObjects() 

mudtModel.ReadObj ects 
End Sub 

' Delegated to Class Model 
5 Public Sub Model_WriteModel() 

mudtModel.WriteModel 

End Sub 

' Delegated to Class Model 
Public Sub Model_WriteObjects() 

10 mudtModelWriteObjects 

End Sub 

' Delegated to Class Model 

Public Function Model_ConstraintsOK(ByVal udtTestType As TestType, _ 
I : ByVal udtProlog As Prolog, blnUnderconstrained As Boolean, _ 

1 II blnTestAborted As Boolean, strUnderconstrainedVN As String) As Boolean 

J ' Model_ConstraintsOK ^ mudtModel.ConstraintsOK(udtTestType, udtProlog, _ 
I blnUnderconstrained, blnTestAborted, strUnderconstrainedVN) 

'f;' End Function 

, ' implemented here 

Public Sub Model_GenerateClones(By Val udtWord As MSWord, ByVal udtProlog As Prolog, 
ByVal intNumClones As Integer, ByVal bytDifference As Byte) 

Call mudtModeLSubstituteValues(Me, udtWord, udtProlog, intNumClones, _ 
bytDifference, 285) 

End Sub 

25 ' Delegated to Class Model 

Public Sub Model_SubstituteValues(ByVal objO As Object, _ 
ByVal udtWord As MSWord, ByVal udtProlog As Prolog, _ 
ByVal intNumClones As Integer, ByVal bytDifference As Byte, 
ByVal intStartPos As Integer) 
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End Sub 



Public Sub CreateVariant(ByVal udtClone As Clone) 

Dim mumber As Integer 
Dim statementRange As Range 
Dim firstNSE As String 
Dim secondNSE As String 

With udtClone.CloneDoc 

mumber = .Tables(l).Rows.Count * Rnd + 0.5 
.Tables(l).Cell(Row:=mumber, Column:=l).Range.Copy 
firstNSE = .Tables(l).Cell(Row:=mumber, Colurrm:==2).Range.Text 
firstNSE - left(firstNSE, 1) 

Set StatementRange = .Bookmarks("tca_fStatement").Range 

statementRange.Paste 

.Tables(l).ConvertToText 

.Bookmarks.Add name:="tca_fStatement", Range "StatementRange 
statementRange.Borders.OutsideLineStyle = wdLineStyleSingle 

' trim hard returns at end of statement 
Dim i, n As Integer 
Dim retchr As String 
retchr = Chr$(13) 

With StatementRange 
n = 0 

i = .Words.Count 

While .Words(i).Text = retchr And i > 1 
i = i- 1 

If .Words(i).Text = retchr Then 

n = n+ 1 
End If 
Wend 

If n > 0 Then 

.Words(. Words.Count - n + l).Delete Count:=n 
End If 
End With 

mumber = .Tables(2).Rows.Count * Rnd + 0.5 
.Tables(2).Cell(Row:=mumber, Column:=l).Range.Copy 
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secondNSE = .Tables(2).Cell(Row:=mumber, Column:=2).Range.Text 
secondNSE = left(secondNSE, 1) 

Set statementRange = .Bookmarks("tca_sStatement").Range 

statementRange.Paste 

.Tables(l).ConvertToText 

.Bookmarks.Add name:="tca_sStatement", Range:=statementRange 
statementRange.Borders.OutsideLineStyle = wdLineStyleSingle 

' trim hard returns at end of statement 
With StatementRange 
n = 0 

i = .Words.Count 

While .Words(i).Text = retchr And i > 1 
i = i- 1 

If . Words(i).Text = retchr Then 

n = n+ 1 
End If 
Wend 

Ifn>OThen 

.Words(.Words.Count - n + l).Delete Count:=n 
End If 
End With 

Dim key As String 
Dim keyChr As String 

If firstNSE = "N" And secondNSE = "N" Then 



key = "E" 
Elself firstNSE- 


"S" 


And secondNSE = 


"S" 


Then 


key = "C orE" 
Elself firstNSE = 


"E" 


And secondNSE = 


"E" 


Then 


key="D" 
Elself firstNSE = 


"N" 


And secondNSE = 


"S" 


Then 


key = "E" 
Elself firstNSE = 


"E" 


And secondNSE = 


"S" 


Then 


key = "A" 
Elself firstNSE = 


"S" 


And secondNSE = 


"E" 


Then 


key = "B" 
Elself firstNSE = 


"N" 


And secondNSE = 


"E" 


Then 


key = "B" 
Elself firstNSE = 


"E" 


And secondNSE = 


"N" 


'Then 


key = "A" 
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End If 

keyChr = left(.Bookmarks("key").Range.Text, 1) 

If keyChr = "A" Or keyChr = "1" Then 
key = "A" 

Elself keyChr - "B" Or keyChr = "2" Then 
key = "B" 

Elself keyChr = "C" Or keyChr = "3" Then 
key = "C" 

Elself keyChr = "D" Or keyChr = "4" Then 
key = "D" 

Elself keyChr = "E" Or keyChr = "5" Then 

key = "E" 
End If 

Dim keyRange As Range 

Set keyRange = .Bookmarks("tca_Key").Range 

Ifkey=""Then 

keyRange.InsertBefore Text:="TCA cannot determine the key" 

Else 

keyRange.InsertBefore Text:="Key is " & key 
End If 

udtClone.key = key 
End With 
End Sub 
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' Family.cls 

VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l True 
END 

Attribute VB_Name = "Family" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer - 1 

' enable i/o 

Private mudtFile As File 

• the .mdf file name of this family 
Private mstrFamilyFN As String 

' the program that owns this family 
Private mudtProgram As Program 

' the item type 

Private mudtltemType As ItemType 

' close/medium far classification 
Private mudtProximity As Proximity 

' generic/non-generic classification 
Private mblnGeneric As Boolean 

' accession number, if this family is based on a locked item 
Private mstrAccNum As String 

' the active model 

Private mudtActiveModel As Model 

' collection of Models 

Private mudtCModels As CModels 

' the collection of accepted clones 
Private mudtCClones As CClones 
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' is dirty? 

Private mblnlsDirty As Boolean 

Public Enum Program 
prGRE = 0 
5 prGMAT = 1 

prSAT = 2 
prMR = 3 
End Enum 

Public Enum ItemType 
10 ptStandardMC = 0 

ptQuantComp = 1 

ptDataSuff=2 
End Enum 

Public Enum Proximity 
15 prNear==0 
■F, prMedium = 1 

J : prFar = 2 
m End Enum 

4- Private Eniun FamilyRecordLayout 

frLocalDatalndex = 1 ' long (takes 4 bytes) 
frClonelndex = 5 ' long 
frLocalData 51 

1 frClones = 201 ' variable length 

X End Enum 

2^ Private Sub Class_Initialize() 

^ Set mudtCModels = New CModels 

Set mudtCClones = New CClones 
mblnlsDirty = False 

End Sub 

30 Public Property Get FileNameQ As String 
FileName = mstrFamilyFN 
End Property 

Public Property Let FileName(ByVal strNewValue As String) 
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mstrFamilyFN - left(strNew Value, Len(strNewValue) - 4) & ".mdf 
End Property 

Public Property Get Program() As Program 

Program = mudtProgram 
End Property 

Public Property Let Program(ByVal udtNewValue As Program) 

mudtProgram = udtNewValue 
End Property 

Public Property Get ItemTypeQ As ItemType 

ItemType = mudtltemType 
End Property 

Public Property Let ItemType(ByVal udtNewValue As ItemType) 

mudtltemType = udtNewValue 
End Property 

Public Property Get ProximityQ As Proximity 

Proximity = mudtProximity 
End Property 

Public Property Let Proximity(ByVal udtNewValue As Proximity) 

mudtProximity = udtNewValue 
End Property 

Public Property Get GenericQ As Boolean 

Generic mblnGeneric 
End Property 
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Public Property Let Generic(ByVal blnNewValue As Boolean) 

mblnGeneric = blnNewValue 
End Property 

Public Property Get AccNuni() As String 

AccNum = mstrAccNum 
End Property 

Public Property Let AccNum(ByVal strNewValue As String) 

mstrAccNum = strNewValue 
End Property 

Public Property Get ActiveModel() As Model 

Set ActiveModel = mudtActiveModel 
End Property 

Public Property Let ActiveModel(ByVal udtModel As Model) 

Set mudtActiveModel = udtModel 
End Property 

Public Property Get ModelsQ As CModels 

Set Models = mudtCModels 
End Property 

Public Property Get ClonesQ As CClones 

Set Clones = mudtCClones 
End Property 

Public Property Let IsDirty(ByVal blnNewValue As Boolean) 
mblnlsDirty = blnNewValue 
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End Property 

Private Property Get IsDirtyQ As Boolean 

If mudtCClones.IsDirty Or mblnlsDirty Then 
5 IsDirty = True 

Else 

IsDirty = False 
End If 

10 End Property 

Public Sub CloseAUCloneDocsO 

Dim udtClone As Clone 

For Each udtClone In mudtCClones 
If;: udtClone.CloseDoc 
Next udtClone 

lil End Sub 

4; Public Sub ReadFamilyQ 
2^'^ Dim udtWAPI As New Win32API 



'X If udtWAPI.FileExists(mstrFamilyFN) Then 

Set mudtFile = New File 

mudtFile.FileName = mstrFamilyFN 
m Call mudtFile.ReadFile(Me, frLocalDatalndex, frClonelndex) 

r:= S et mudtFile = Nothing 

Call mudtCClones.ReadCollection(mstrFamilyFN, frClonelndex, READ_UNTIL_EOF) 

End If 
30 End Sub 

PubUc Sub ReadObjectsO 
Dim vField As Variant 

Call mudtFile.ReadField(vField) ' returns the version stamp 
35 Call mudtFile,ReadField(vField) 

Program = vField 
Call mudtFile.ReadField(vField) 
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ItemType = vField 

Call mudtFile.ReadField(vField) 

Generic = vField 

Call mudtFile.ReadField(vField) 

Proximity = vField 

Call mudtFile.ReadField(vField) 

AccNum = vField 

End Sub 

Public Sub WriteFamilyO 

Dim udtPB As New Progress 

IflsDirtyThen 

Set mudtFile = New File 
mudtFile.FileName = mstrFamilyFN 
Call udtPB.Init(2, "Saving family...") 

Call mudtFile. WriteFile(Me, True, frLocalDatalndex, frLocalData) 

udtPB.Advance 

Set mudtFile = Nothing 

Call mudtCClones.WriteCollection(mstrFamilyFN, frClonelndex, frClones) 
udtPB.Advance 
End If 

IsDirty = False 
End Sub 

Public Sub WriteObjectsO 

CallmudtFile.WriteField(mintVERSIONSTAMP) 

Call mudtFile.WriteField(Program) 

Call mudtFile.WriteField(ItemType) 

Call mudtFile.WriteField(Generic) 

CallmudtFile.WriteField(Proximity) 

Call mudtFile.WriteField(AccNum) 

End Sub 
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' File.cls 

VERSION 1.0 CLASS 
BEGIN 

Multiuser 0 Talse 

Persistable = 0 'NotPersistable 

DataBindingBehavior 0 'vbNone 

DataSourceBehavior ^0 VbNone 

MTSTransactionMode =0 'NotAnMTSObject 
END 

Attribute VB_Name - "File" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

' Path and name of the file to open 
Private m_sFileName As String 

' File number opened 

Private mJFileNumber As Integer 

' passed in by ReadFile 
Private mlngEndPos As Long 

' Error constants 
Enum FileError 

fileOpenError ^ vbObjectError +512 + 2 

fileEOFError = vbObjectError + 512 + 3 

fileReadError = vbObjectError + 512 + 4 

fileWriteError = vbObjectError + 512 + 5 

fileStopReadingError = vbObjectError + 512 + 6 
End Enum 

Property Get FileNameQ As String 

Attribute FileName.VB_Description = "Name of the file to contain the task information." 

FileName ^ m_sFileName 
End Property 

Property Let FileName(ByVal sFileName As String) 
' Should validate valid path here 
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m_sFileName = sFileName 
End Property 

' Reads all objects from a file into the defined object 
' Parameters: 

Public Sub ReadFile(obj As Object, Optional ByVal IngStartlndex As Long 
Optional ByVal IngEndlndex As Long = 0) 

Dim IngStartPos As Long 

' Enable error handling 
On Error Resume Next 

' Get the file number 
mJFileNumber = FreeFile 

' Open the file and trap any errors 

Open m_sFileName For Binary Access Read As #m_iFileNumber 
Select Case err.Number 

Case 0 ' No error 

IflngEndIndex>OThen 

Seek mJFileNumber, IngEndlndex 

Get #mJFileNumber, , mlngEndPos 
Else 

mlngEndPos ^ 0 
End If 

If IngStartlndex > 0 Then 

Seek mJFileNumber, IngStartlndex 

Get #mJFileNumber, , IngStartPos 

Seek mJFileNumber, IngStartPos 
End If 

obj.ReadObjects ' Get the data 

Case 53 ' File not found 
' Do nothing 

Case Else 

' Turn off error handling here 
On Error GoTo 0 

' Pass the error out 

err.Raise fileOpenError, "CFile::ReadFile", "Error opening file." 
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End Select 
' Close the file 
Close #m_iFileNumber 
End Sub 

' Reads a field from the file 
' Parameters: 

' vField field read from the file 

Public Sub ReadField(vField As Variant) 
' Set the error handler 
On Error GoTo ERR_HANDLER 

Get #m_iFileNumber, , vField 

If EOF(m_iFileNumber) Then 

' Reached end of file 

err.Raise fileEOFError 
End If 

If mlngEndPos > 0 Then 

If mlngEndPos < Seek(m_iFileNumber) Then 
err.Raise fileStopReadingError 

End If 
End If 

Exit Sub 

ERR_HANDLER: 
' Pass the error out 
Select Case err.Number 

Case fileEOFError 

Call err.Raise(err.Number, "File::ReadField", "EOF") 
Case fileStopReadingError 

Call err.Raise(err.Number, "File::ReadField", "Stop!") 
Case Else 

Call err.Raise(fileReadError, "File::ReadField", err.Description) 
End Select 
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End Sub 

' Writes all objects to the file. 

' Parameters: 

' obj Object 

Public Function WriteFile(obj As Object, _ 

Optional ByVal blnKillOldFile As Boolean = False, _ 
Optional ByVal InglndexPos As Long = 0, _ 
Optional ByVal IngSeekPos As Long = 1) As Long 

' Enable error handling 
On Error Resume Next 

If blnKillOldFile Then ' assume new file, otherwise append 

Kill m_sFileName ' Kill the existing file 

err.Clear 
End If 

' Get the file number 
mJFileNumber = FreeFile 

' Open the file and trap any errors 

Open m_sFileName For Binary As #m_iFileNumber 

' write the starting file position, if InglndexPos > 0 
If InglndexPos > 0 Then 

Seek m_iFileNumber, InglndexPos 
Put #m_iFileNumber, , IngSeekPos 
End If 

' seek to starting position 

Seek mJFileNumber, IngSeekPos 

Select Case err.Number 
Case 0 ' No error 
' Write the data 
obj.WriteObjects 

Case Else 

' Turn off error handling here 
On Error GoTo 0 

' Pass the error out 

err.Raise fileOpenError, "CFile::WriteFile", _ 
"Error opening file: " & err.Description 
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End Select 



' return current position 
WriteFile = Seek(m_iFileNumber) 

' Close the file 

Close #m_iFileNumber 

End Function 

' Write a field to the file 
' Parameters: 

' vField field to write to the file 

Public Sub WriteField(ByVal vField As Variant) 

' Set the error handler 

On Error GoTo ERR_HANDLER 

Put #m_iFileNumber, , vField 

Exit Sub 

ERR_HANDLER: 

err.Raise fileWriteError, "CFile::WriteField", _ 
"Write Error: " & err.Descpription 
End Sub 
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' FileFind.cls 
VERSION LO CLASS 
BEGIN 
MultiUse = -1 True 
END 

Attribute VB_Name - "FileFind" 
Attribute VB_GlobalNaineSpace = False 
Attribute VB_Creatable = Trae 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

' used for finding files that fit a mask 



Private Type FILETIME 

dwLowDateTime As Long 

dwHighDateTime As Long 
End Type 

Private Const MAX_PATH - 260 

Private Type WIN32_FIND_DATA 

dwFileAttributes As Long 

ftCreationTime As FILETIME 

ftLastAccessTime As FILETIME 

ftLastWriteTime As FILETIME 

nFileSizeHigh As Long 

nFileSizeLow As Long 

dwReservedO As Long 

dwReservedl As Long 

cFileName As String * MAX_PATH 

c Alternate As String * 14 
End Type 

Private Const INVALID_HANDLE_VALUE = -1 

Private Declare Function FindFirstFile Lib "kemel32" Alias "FindFirstFileA" _ 
(ByVal IpFileName As String, IpFindFileData As WIN32_FIND_DATA) As Long 

Private Declare Function FindNextFile Lib "kemel32" Alias "FindNextFileA" _ 
(ByVal hFileName As Long, IpFindFileData As WIN32_FIND_DATA) As Long 

Private Declare Function FindClose Lib "kemel32" (ByVal hFindFile As Long) As Long 
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Private Declare Function GetCurrentDirectory Lib "kemel32" _ 
Alias "GetCurrentDirectory A" (ByVal nBufferLength As Long, _ 
ByVal IpBuffer As String) As Long 

' returns true if strFN exists 

Public Function Exists(ByVal strFN) As Boolean 

Dim IngHandle As Long 

Dim w32FindData As WIN32_FIND_DATA 

IngHandle =^ FindFirstFile(strFN, w32FindData) 

If IngHandle = INVALID_HANDLE_VALUE Then 

Exists = False 
Else 

Exists ^ True 

Call FindClose(lngHandle) 
End If 

End Function 

' returns a collection of file names that satisfy strMask. The path seems to 
' disappear from the returned file names. 

Public Function FindAll(ByVal strMask As String) As Collection 

Dim IngHandle As Long 
Dim IngRet As Long 

Dim w32FindData As WIN32_FIND_DATA 

Dim StrFN As String 

Dim varl As Variant 

Dim colFNs As New Collection 

IngHandle = FindFirstFile(strMask, w32FindData) 

If IngHandle - INVALID_HANDLE^VALUE Then 

Exit Function 
End If 

Do 

varl = InStr(l, w32FindData.cFileName, Chr(O)) ' trim off the nulls 
strFN left(w32FindData.cFileName, varl - 1) 
Call colFNs. Add(strFN) ' add to the collection 

Loop Until FindNextFile(lngHandle, w32FindData) = 0 
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Set FindAll = colFNs 



End Function 

' returns the current directory 

Public Function CurrentDirectory() As String 

Dim strBuf As String 
Dim IngRet As Long 
Dim varl As Variant 

StrBuf = Space(300) 

IngRet - GetCurrentDirectory(300, strBuf) 
varl = InStr(l, strBuf, Chr(O)) ' trim off the nulls 
CurrentDirectory = left(strBuf, varl - 1) 

End Function 
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' GMATDifficultyEstimate.cls 
VERSION LO CLASS 
BEGIN 
MultiUse = -l 'Trae 
END 

Attribute VB_Name - "GMATDifficultyEstimate" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable ^ True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer = 1 

Implements DifficultyEstimate 

Private mudtDE As DifficultyEstimate 

' these go into the GMAT model 
Private mudtDomain As Domain 
Private mstrKey As String 
Private mudtNature As Nature 
Private mudtltemType As ItemType 
Private mintTDDiffEst As Integer 

Private Sub Class_Initialize() 

Set mudtDE = New DifficultyEstimate 

End Sub 

Private Sub Class_Terminate() 

Set mudtDE = Nothing 
End Sub 

Public Property Get DifficultyEstimate_IsDirty() As Boolean 

DifficultyEstimate_IsDirty = mudtDE. IsDirty 
End Property 



VBSCA -336- 



Public Property Let DifficultyEstimate_IsDirty(ByVal blnNewValue As Boolean) 

mudtDE.IsDirty = blnNewValue 
End Property 

Public Property Let Domain(ByVal udtNewValue As Domain) 

mudtDomain = udtNewValue 
End Property 

Public Property Let Nature(ByVal udtNewValue As Nature) 

mudtNature = udtNewValue 
End Property 

Public Property Let Key(ByVal strNewValue As String) 

mstrKey ^ strNewValue 
End Property 

Public Property Let ItemType(ByVal udtNewValue As ItemType) 

mudtltemType = udtNewValue 
End Property 

Public Property Let TDDiffEst(ByVal intNewValue As Integer) 

mintTDDiffEst = intNewValue 
End Property 

Public Function DifficultyEstiinate_ComputeDifficulty() As Double 

Dim dblDiff As Double 

dblDiff= -2.3289902 

' add coeff for domain 
If mudtDomain = doAlgebra Then 
dblDiff = dblDiff + 0.2341578 
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Elself mudtDomain = doGeometry Then 

dblDiff = dblDiff + 0.3749013 
End If 

' add coeff for real 

If mudtNature = naReal Then 

dblDiff = dblDiff + 0.3285613 
End If 

' add coeff for td difficulty estimate 

dblDiff = dblDiff + ((6 - mintTDDifffist) * 0.7024191) 

' add coeff for key 

If mudtltemType = ptDataSuff Then 

If mstrKey = "A" Or mstrKey = "B" Then 
dblDiff = dblDiff 4- 0,7334054 

End If 
End If 

DifficultyEstimate_ComputeDifficulty dblDiff 
End Function 

' returns a copy of this object 

Public Function DifficultyEstimate_Copy() As DifficultyEstimate 
Dim udtGmatDE As New GMATDifficultyEstimate 
Set DifficultyEstimate_Copy = udtGmatDE 

End Function 

PubHc Sub DifficultyEstimate_ReadObjectData(udtFile As File) 
Dim vField As Variant 

Call udtFile,ReadField(vField) ' reads the version stamp 
End Sub 

Public Sub DifficultyEstimate_WriteObjectData(udtFile As File) 
Call udtFile.WriteField(mintVERSIONSTAMP) 
mudtDETsDirty = False 
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End Sub 
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' GREDifficultyEstimate.cls 
VERSION 1.0 CLASS 
BEGIN 
Multiuser -1 Trae 
END 

Attribute VB_Name = "GREDifficultyEstimate" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer - 1 

Implements DifficultyEstimate 

Private mudtDE As DifficultyEstimate 

' these go into the GRE model 

Private mudtDomain As Domain 

Private mudtComputation As GREComputation 

Private mudtCognition As GRECognition 

Private mudtConcept As GREConcept 

Private mstrKey As String 

Private mudtNature As Nature 

Private mudtltemType As ItemType 

Public Enum GREComputation 

grintegers = 0 

grDecimalsFractions = 1 

grRadicals = 2 

grNone = 3 
End Enum 

Public Enum GRECognition 

grProcedural = 0 

grConceptual = 1 

grHigherOrderThinking = 2 
End Enum 

Public Enum GREConcept 
grProbability = 0 
grPercentofPercent = 1 



VBSCA -340- 



grPercentChange = 2 
grLinearlnequality = 3 
grNoneOfThese = 4 
End Enum 

Private Sub Class_Initialize() 

Set mudtDE = New DifficultyEstimate 
End Sub 

Private Sub Class_Terminate() 

Set mudtDE = Nothing 
End Sub 

Public Property Get DifficultyEstimate_IsDirty() As Boolean 

DifficultyEstimate__IsDirty = mudtDE JsDirty 
End Property 

Public Property Let DifficultyEstimate_IsDirty(ByVal blnNewValue As Boolean) 

mudtDE. IsDirty = blnNewValue 
End Property 

Public Property Let Domain(ByVal udtNewValue As Domain) 

mudtDomain = udtNewValue 
End Property 

Public Property Get ComputationQ As GREComputation 

Computation = mudtComputation 
End Property 

Public Property Let Computation(ByVal udtNewValue As GREComputation) 

If mudtComputation <> udtNewValue Then 
mudtComputation = udtNewValue 
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mudtDE.IsDirty = True 
End If 

End Property 

Public Property Get CognitionQ As GRECognition 

Cognition = mudtCognition 
End Property 

Public Property Let Cognition(ByVal udtNewValue As GRECognition) 

If mudtCognition <> udtNewValue Then 

mudtCognition = udtNewValue 

mudtDETsDirty = True 
End If 

End Property 

Public Property Get ConceptQ As GREConcept 

Concept = mudtConcept 
End Property 

Public Property Let Concept(ByVal udtNewValue As GREConcept) 

If mudtConcept <> udtNewValue Then 

mudtConcept = udtNewValue 

mudtDETsDirty = True 
End If 

End Property 

Public Property Get NatureQ As Nature 

Nature = mudtNature 
End Property 

Public Property Let Nature(ByVal udtNewValue As Nature) 
mudtNature = udtNewValue 
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End Property 

Public Property Get Key() As String 

Key = mstrKey 
End Property 

Public Property Let Key(ByVal strNewValue As String) 

If mstrKey <> strNewValue Then 

mstrKey = strNewValue 

mudtDE JsDirty = True 
End If 

End Property 

Public Property Get ItemType() As ItemType 

ItemType = mudtltemType 
End Property 

Public Property Let ItemType(ByVal udtNewValue As ItemType) 

mudtltemType = udtNewValue 
End Property 

Public Function DifficultyEstimate_ComputeDifficulty() As Double 

Dim dblDiff As Double 

dblDiff= 0.3296816 

' add coeff for domain 

If mudtDomain = do Algebra Then 

dblDiff - dblDiff + 0.2464302 
Elself mudtDomain = doDataAnalysis Then 

dblDiff- dblDiff - 0.3944198 
End If 

' add coeff for computation 
If mudtComputation = grintegers Then 
dblDiff = dblDiff - 0.8563799 
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Elself mudtComputation = grDecimalsFractions Then 

dblDiff = dblDiff - 0.5181709 
End If 

' add coeff for cognition 
If mudtCognition = grProcedural Then 
dblDiff = dblDiff - 0.6621277 

If mudtNature = naReal Then ' add coeff for procedural and real 

dblDiff= dblDiff- 0.8781659 
End If 

Elself mudtCognition = grHigherOrderThinking Then 

dblDiff = dblDiff + 0.7253093 
End If 

' add coeff for concept 
Select Case mudtConcept 
Case grLinearlnequality 

dblDiff = dblDiff - 0.5881492 
Case grNoneOflhese 

' do nothing 
Case Else 

dblDiff = dblDiff + 0.5835095 
End Select 

' add coeff for key 

If mudtltemType = ptQuantComp Then 

If mstrKey - "A" Or mstrKey = "B" Or mstrKey = "C" Then 
dblDiff- dblDiff- 0.531099 

End If 
End If 

DifficultyEstimate_ComputeDifficulty = dblDiff 
End Function 

' returns a copy of this object 

Public Function DifficultyEstimate_Copy() As DifficultyEstimate 

Dim udtGreDE As New GREDifficultyEstimate 

udtGreDE. Computation = Computation 
udtGreDE.Cognition = Cognition 
udtGreDE. Concept = Concept 

Set DifficultyEstimate_Copy ^ udtGreDE 
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End Function 

Public Sub DifficultyEstimate_ReadObjectData(udtFile As File) 
Dim vField As Variant 

Call udtFile.ReadField(vField) ' reads the version stamp 

Call udtFile.ReadField(vField) 
Computation = vField 

Call udtFile.ReadField(vField) 
Cognition = vField 

Call udtFile.ReadField(vField) 
Concept = vField 

End Sub 

Public Sub DifficultyEstimate_WriteObjectData(udtFile As File) 

Call udtFile.WriteField(mintVERSIONSTAMP) 
Call udtFile.WriteField(Computation) 
CalludtFile.WriteField(Cognition) 
Call udtFile.WriteField(Concept) 

mudtDE.IsDirty = False 

End Sub 



' IniFile.cls 

VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l 'True 
END 

Attribute VB_Name = "IniFile" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 

' this class handles all ini file reads and writes via kemel32 
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Option Explicit 

' the following declares are needed to get and put to .ini files 

Private Declare Function GetPrivateProfileSection Lib "kemel32" Alias _ 

"GetPrivateProfileSectionA" (ByVal IpAppName As String, _ 

ByVal IpRetumedString As String, ByVal nSize As Long, _ 

ByVal IpFileName As String) As Long 

Private Declare Function GetPrivateProfileString Lib "kemel32" Alias _ 
"GetPrivateProfileStringA" (ByVal IpApplicationName As String, __ 
ByVal IpKeyName As Any, ByVal IpDefault As String, _ 
ByVal IpRetumedString As String, ByVal nSize As Long, _ 
ByVal IpFileName As String) As Long 

Private Declare Function WritePrivateProfileSection Lib "kemel32" Alias _ 
"WritePrivateProfileSectionA" (ByVal IpAppName As String, _ 
ByVal IpString As String, ByVal IpFileName As String) As Long 

Private Declare Function WritePrivateProfileString Lib "kemel32" Alias _ 
"WritePrivateProfileStringA" (ByVal IpApplicationName As String, _ 
ByVal IpKeyName As Any, ByVal IpString As Any, ByVal IpFileName As String) 
As Long 

' contains file name of ini 
Private mstrFN As String 

' holds collection of keys created by Get Profiles ection method 
Private mcolKeys As Collection 

' holds collection of values created by Get ProfileSection method 
Private mcolValues As Collection 

Private Sub Class_Initialize() 

Set mcolKeys = New Collection 
Set mcolValues = New Collection 

End Sub 

' sets the ini path + file name 

Public Property Let FN(ByVal strFN As String) 

mstrFN = strFN 

End Property 
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' returns the ini path + file name 
Public Property Get FN() As String 

FN = mstrFN 

5 End Property 

'gets all of the keys and values in a section 

Public Sub GetProfileSection(ByVal strSectionName As String) 

Dim strRet As String 
strRet = Space(5000) 

10 If GetPrivateProfileSection(strSectionName, strRet, 5000, mstrFN) = 0 Then 

Call MsgBox("Ini file call unsuccessfial", vbExclamafion, "Error") 
End If 

Dim IngStart As Long 
11= Dim IngEnd As Long 

Dim strl As String 
01 Dim str2 As String 
111 Dim varT As Variant 
4= Dim strT As String 

2#= ' parse the key and variable names out of strRet, add to the collections 

For IngStart = 1 To Len(strRet) 
1, strl - Mid(strRet, IngStart, 1) 

y If strl <>Chr(0) Then 

J::;: For IngEnd = IngStart + 1 To Len(strRet) 

2|[ str2 = Mid(strRet, higEnd, 1) 

r==E Select Case str2 

c! Case 

StrT = Mid(strRet, IngStart, IngEnd - IngStart) 
Call mcolKeys.Add(strT) 
30 Exit For 

Case Chr(O) 

StrT = Mid(strRet, IngStart, IngEnd - IngStart) 
Call mcol Values. Add(strT) 
Exit For 

35 End Select 

Next IngEnd 
IngStart = IngEnd 
End If 
Next IngStart 



40 
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End Sub 



' called after LoadProfileSection. 

' sets strKey and strValue to the the KeyValue pairs if one exists 
' at this index. 

' returns TRUE if the index exists, FALSE if it doesn't. 

Pubhc Function GetKeyValuePair(strKey As String, strValue As String, _ 
ByVal intlndex As Integer) As Boolean 

If intlndex <= mcolKeys. Count Then 

StrKey = mcolKeys.Item(intlndex) 

StrValue ^ mcolValues.Item(intlndex) 

GetKey ValuePair = True 
Else 

StrKey = 

StrValue-"" 

GetKey ValuePair = False 
End If 

End Function 

' init before loading key/value pairs 
Public Function InitializeKeyValuePairs() 

Set mcolKeys = Nothing 
Set mcolValues = Nothing 
Set mcolKeys = New Collection 
Set mcolValues = New Collection 

End Function 

Public Sub SetKeyValuePair(ByVal strKey As String, ByVal strValue As String) 

Call mcolKeys.Add(strKey) 
Call mcolValues.Add(strValue) 

End Sub 

PubUc Sub WriteProfileSection(ByVal strSectionName As String) 

Dim strSection As String 
Dim varKey As Variant 
Dim varValue As Variant 
Dim inti As Integer 
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For Each varKey In mcolKeys 
inti - inti + 1 

varValue = mcol Values. Item(intl) 

strSection = strSection & varKey & ' & varValue & Chr(O) 
Next varKey 

If WritePrivateProfileSection(strSectionName, strSection, mstrFN) = 0 Then 
Call MsgBox("Ini file write section call unsuccessful", _ 
vbExclamation, "Error") 

End If 

End Sub 

' returns the number of keys currently in the key/value collections 
Public Property Get NumKeysQ As Integer 

NumKeys = mcolKeys. Count 

End Property 

'gets a value 

Public Function GetProfileString(ByVal strSectionName As String, _ 
ByVal strKeyName As String) As String 

Dim strRet As String 
strRet = Space(5000) 

Call GetPrivateProfileString(strSectionName, strKeyName, "Not Found", _ 

StrRet, 5000, mstrFN) 
GetProfileString = TrimAtFirstNull(strRet) 

End Function 

'sets a value 

Pubhc Sub WriteProfileString(ByVal strSectionName As String, _ 
ByVal StrKeyName As String, ByVal strKey Value As String) 

Call WritePrivateProfileString(strSectionName, strKeyName, strKeyValue, _ 
mstrFN) 

End Sub 
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' Lockedltem.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse--l True 
END 

Attribute VB_Name = "Lockedltem" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = Trae 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Private mstrLockedFN As String 

Private mudtWord As MSWord 

Private mdocLockedltem As Document 

Private mudtltemType As ItemType 

Private mudtDeliveryMode As DeliveryMode 

Public Enum DeliveryMode 

dmCBT = 0 

dmPPT - 1 
End Enum 

Public Property Let LockedItemFileName(ByVal strNewValue As String) 

mstrLockedFN = strNewValue 
End Property 

Public Property Let WordInstance(ByVal udtNewValue As MSWord) 

Set mudtWord = udtNewValue 
End Property 

Public Property Get DeliveryModeQ As DeliveryMode 

DeliveryMode = mudtDeliveryMode 
End Property 
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Public Property Get ItemType() As ItemType 

ItemType = mudtltemType 
End Property 

Public Function OpenLockedltemDocQ As Boolean 

Dim udtProgress As New Progress 

Call udtProgress.Init(2, "Opening locked item.,.") 
udtProgress.Advance 

Set mdocLockedltem ^ mudtWord.WordApp.Documents,Open(mstrLockedFN) 

If mdocLockedltem.ProtectionType <> wdNoProtection Then 

Call mdocLockedItem.Unprotect("ItemEdit") 
End If 

OpenLockedltemDoc = AnalyzeLockedltem 
udtProgress.Advance 
End Function 

Public Sub CloseLockedltemDocQ 

mdocLockedltem. Close 

Clipboard.Clear 
End Sub 

Private Function AnalyzeLockedltemQ As Boolean 

' true if document is successfully analyzed 
AnalyzeLockedltem = True 

If mdocLockedltem.Tables.Count = 1 Then ' QC item 
mudtltemType = ptQuantComp 
If mdocLockedltem.Bookmarks.Count = 3 Then 

mudtDeliveryMode = dmPPT 
Else 

mudtDeliveryMode = dmCBT 
End If 
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Elself mdocLockedltem.ListParagraphs. Count = 2 Then ' DS 
mudtltemType = ptDataSuff 
mudtDeliveryMode = dmCBT 

Elself mdocLockedltem.ListParagraphs.Count = 5 Then ' SMC 
mudtltemType = ptStandardMC 
mudtDehveryMode = dmCBT 

Elself mdocLockedItem.Bookmarks.Exists("prop_key") = True Then 
mudtltemType = ptStandardMC 
mudtDeliveryMode = dmPPT 

Else 

AnalyzeLockedltem = False 
End If 

End Function 

Public Sub ConvertCBTSMCItemO 
Dim udtProgress As New Progress 

Call udtProgress,Init(2, "Converting SMC CBT locked item...") 
Dim tcaDoc As Document 

Set tcaDoc = mudtWord.WordApp.ActiveDocument 

Dim stemRange As Range 
Set StemRange = mdocLockedltem. Content 
stemRange.Find.Style = "Heading T 
stemRange.Find.Execute FindText:="Stem" 
StemRange. Start ^ stemRange. Start + 5 

Dim respRange As Range 
Set respRange = mdocLockedltem. Content 
respRange.Find. Style "Heading 2" 
respRange.Find.Execute FindText:="Response" 

stemRange.End respRange. Start - 1 
StemRange. Copy 

Dim destRange As Range 

Set destRange ^ tcaDoc.Bookmarks("stemr').Range 
With destRange 
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.Borders.Enable = False 
.Words(l).Delete Count:=6 
.Collapse 
.Paste 

.Style = wdStyleNonnal 
.Borders.Enable ^ True 
End With 



destRange.Borders. Enable = False 
destRange. Collapse 
destRange.Delete 
destRange.Paste 
destRange.InsertParagraphAfter 
destRange. Style = wdStyleNormal 
destRange.Borders.Enable = True 

With destRange.ParagraphFormat.Borders 

.Enable = True 

.DistanceFromTop = 1 

.DistanceFromLeft ^ 4 

.DistanceFromBottom = 1 

.DistanceFromRight = 4 
End With 



If destRange.Borders.InsideLineStyle = True Then 

destRange.Borders. InsideLineStyle = wdLineStyleNone 
End If 

tcaDoc.Bookmarks.Add Name:="stemr', Range :=destRange 



Dim nextRange As Range 
Dim Key As String 
Dim abcde As String 
abode - "ABCDE" 
Dim i As Integer 
Dim n As Integer 
n-1 



Dim udtIF As New IniFile 

udtlF.FN = IN_DIRECTORY & ExtractFileNameNoExt(mstrLockedFN) & ' 
Key = udtIF.GetProfileString("LockedItemData", "Key") 



udtProgress.Advance 
Dim tabchr As String 
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tabchr = Chr$(9) 
For i = 1 To 5 



Set respRange = mdocLockedItem.ListParagraphs(i),Range 
respRange.Copy 

If Key = Mid(abcde, i, 1) Then 

Set destRange = tcaDoc.Bookmarks("Key").Range 
Else 

Set destRange = tcaDoc.Bookmarks("resp" & Fonnat(n)).Range 
n = n+ 1 
End If 

With destRange 

.Borders.Enable = False 

.Words(l).Delete 

.Collapse 

.Paste 

.Style = wdStyleNonnal 
.Borders.Enable = True 

If ,Words(l).Text = tabchr Then 

.Words(l).Delete 
End If 

.Words(destRange.Words.Count).Delete 
End With 

Next 

udtProgress.Advance 
End Sub 

Public Sub ConvertPPTSMCItemO 
Dim udtProgress As New Progress 

Call udtProgress.Init(2, "Converting SMC PPT locked item...") 
Dim tcaDoc As Document 

Set tcaDoc = mudtWord.WordApp.ActiveDocument 
Dim stemStart As Long 
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Dim destRange As Range 

Set destRange = tcaDoc.Bookmarks("stemr').Range 
stemStart ^ destRange, Start 

Dim stemRange As Range 
' Set StemRange = mdocLockedItem3ookmarks("itemnum").Range 
' StemRange. Start = stemRange. Start + 1 

Set StemRange ^ mdocLockedltem.Content 

stemRange.Find.Style = "PPTStimulus" 

If stemRange.Find.Execute Then 
StemRange. Copy 
destRange.Paste 

destRange.CoUapse Direction: =wdCollapseEnd 
End If 

Set stemRange = mdocLockedltem.Content 

StemRange.Find.Style = "PPTStem" 

StemRange.Find.Execute 

StemRange. Copy 

destRange.Paste 

destRange. Style = wdStyleNormal 

destRange. Start = stemStart 
destRange.Borders.Enable = True 

' With destRange.ParagraphFormat.B orders 

' .Enable = True 

' .DistanceFromTop = 1 

' .DistanceFromLeft = 4 

' .DistanceFromBottom = 1 

' .DistanceFromRight = 4 

' End With 

If destRange.Borders.InsideLineStyle = True Then 

destRange.Borders.InsideLineStyle = wdLineStyleNone 
End If 

tcaDoc.Bookmarks.Add Namei^^'steml", Range :^destRange 

Dim nextRange As Range 
Dim respRange As Range 
Dim Key As String 
Dim abcde As String 
abcde = "ABCDE" 
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Dim i As Integer 
Dim n As Integer 
n=l 

Dim udtIF As New IniFile 

udtlF.FN = IN_DIRECTORY & ExtractFileNameNoExt(mstrLockedFN) & 
Key = udtlF.GetProfileStringC'LockedltemData", "Key") 

udtProgress.Advance 

For i = 1 To 5 

Set respRange = mdocLockedltem. Content 
respRange.Find. Style = "PPTOptions" 

respRange.Find.Execute FindText:="(" & Mid(abcde, i, 1) & ")" 
respRange. Start = respRange. Start + 4 

Set nextRange = mdocLockedltem.Content 

Ifi<5Then 

nextRange.Find.Style = "PPTOptions" 

nextRange.Find.Execute FindText:="(" & Mid(abcde, i + 1, 1) & ")" 
Else 

nextRange.Find.Style = "ItemLabel" 
nextRange.Find.Execute FindText:="Scratch Pad" 
End If 

respRange.End = nextRange. Start - 1 
respRange. Copy 

If Key = Mid(abcde, i, 1) Then 

Set destRange = tcaDoc.Bookmarks("Key").Range 
Else 

Set destRange tcaDoc.Bookmarks("resp" & Format(n)). Range 
n = n+ 1 
End If 

destRange.Words(l).Delete 
destRange. Collapse 
destRange.Paste 

Next 

udtProgress.Advance 
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End Sub 



Public Sub ConvertDSItemO 

Dim udtProgress As New Progress 

Call udtProgress Jnit(2, "Converting DS CBT locked item...") 
Dim tcaDoc As Document 

Set tcaDoc = mudtWord.WordApp.ActiveDocument 

Dim stemRange As Range 
Set StemRange = mdocLockedltem. Content 
stemRange.Find. Style = "Heading 2" 
stemRange.Find.Execute FindText:="Stem" 
stemRange.Start = stemRange. Start + 5 

Dim respRange As Range 

Set respRange = mdocLockedltem. Content 

respRange.Find.Style = "DataSuffStatement" 

respRange.Find.Execute 

stemRange.End = respRange. Start - 1 
stemRange.Copy 

Dim destRange As Range 

Set destRange = tcaDoc.Bookmarks("steml").Range 
destRange.Borders.Enable = False 
destRange. Collapse 
destRange.Paste 
' destRange.Borders.Enable = True 

With destRange.ParagraphFormat.Borders 

.Enable = True 

.DistanceFromTop = 1 

.DistanceFromLeft = 4 

.DistanceFromBottom = 1 

.DistanceFromRight = 4 
End With 

If destRange.Borders.HasHorizontal = True Then 

destRange.Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone 
End If 

Dim Key As String 
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Dim udtIF As New IniFile 

udtlFJN = IN_DIRECTORY & ExtractFileNameNoExt(mstrLockedFN) & ".ini" 
Key - udtlF.GetProfileStringC'LockedltemData", "Key") 

Set destRange = tcaDoc.Bookmarks("Key").Range 
destRange.Words(l).Delete 
destRange.InsertBefore Text:=Key 

udtProgress Advance 

Dim i As Integer 

For i = 1 To 2 

Set respRange = mdocLockedItem.ListParagraphs(i).Range 
respRange.Copy 

Set destRange = tcaDoc.Tables(i),Cell(Row:=l, Column:=l).Range 
destRange.Paste 

destRange.Style = wdStyleNormal 
Next 

udtProgress. Advance 
End Sub 

Public Sub ConvertCBTQCItemO 
Dim udtProgress As New Progress 

Call udtProgress.Init(2, "Converting QC CRT locked item...") 
Dim tcaDoc As Document 

Set tcaDoc = mudtWord.WordApp.ActiveDocument 
Dim stemRange As Range 

Set StemRange = mdocLockedItem.Tables(l).Cell(Row:=l, Column:=l).Range 
stemRange.Copy 

Dim destRange As Range 

Set destRange = tcaDoc.Bookmarks("steml").Range 
destRange.Borders.Enable = False 
destRange. Words(2).Delete 
destRange. Words(l).Delete 
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destRange, Collapse 
destRange.Paste 

tcaDoc.Tables(2),Rows.SetLeftIndent LeftIndent:--0,6, RulerStyle:=wdAdjustNone 
tcaDoc.Tables(2).ConvertToText Separator -wdSeparateByTabs 
destRange.Borders. Enable = True 

tcaDoc.Bookmarks.Add Name:="stemr', Range :=destRange 

Dim Key As String 

Dim udtIF As New IniFile 

udtlF.FN = IN_DIRECTORY & ExtractFileNameNoExt(mstrLockedFN) & ".ini" 
Key - udtlF.GetProfileStringC'LockedltemData", "Key") 

Set destRange = tcaDoc.BookmarksC'Key").Range 
destRange .Words( 1 ) .D elete 
destRange.InsertBefore Text:=Key 

udtProgress. Advance 

Dim respRange As Range 

Set respRange = mdocLockedItem.Tables(l).Cell(Row:-2, Column:=l).Range 
respRange.Copy 

Set destRange = tcaDoc.Bookmarks("columnA").Range 

destRange. Collapse 

destRange.Paste 

Set respRange = mdocLockedItem.Tables(l).Cell(Row:=2, Column:=2).Range 
respRange.Copy 

Set destRange ^ tcaDoc.Bookmarks("columnB").Range 

destRange. Collapse 

destRange.Paste 

udtProgress.Advance 

End Sub 

Public Sub ConvertPPTQCItemO 
Dim udtProgress As New Progress 

Call udtProgress.Init(2, "Converting QC PPT locked item...") 
Dim tcaDoc As Document 

Set tcaDoc ^ mudtWord.WordApp.ActiveDocument 
Dim stemRange As Range 
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Set stemRange = mdocLockedItem.Tables(l).Cell(Row:=l, Column:=2).Range 
stemRange.Copy 

Dim destRange As Range 

Set destRange = tcaDoc.Bookmarks("stemr').Range 

destRange.Borders.Enable = False 

destRange.Words(2).Delete 

destRange. Words( 1 ) .Delete 

destRange.Collapse 

destRange.Paste 

tcaDoc.Tables(2).Rows.SetLeftIndent LeftIndent:=-0.6, RulerStyle:-^dAdjustNone 
tcaDoc.Tables(2).ConvertToText Separator:=wdSeparateByTabs 
destRange.Borders.Enable = True 

tcaDoc.Bookmarks.Add Name:="stemr', Range :=destRange 

Dim Key As String 

Dim udtIF As New IniFile 

udtlF.FN = IN_DIRECTORY & ExtractFileNameNoExt(mstrLockedFN) & ".ini" 
Key - udtlF.GetProfileStringC'LockedltemData", "Key") 

Set destRange = tcaDoc.Bookmarks("Key").Range 
destRange. Words(l).Delete 
destRange.InsertBefore Text:=Key 

udtProgress.Advance 

Dim respRange As Range 

Set respRange = mdocLockedItem.Tables(l).Cell(Row:=2, Column:=2).Range 
respRange. Copy 

Set destRange ^ tcaDoc.Bookmarks("columnA").Range 

destRange.Collapse 

destRange.Paste 

Set respRange = mdocLockedItem.Tables(l).Cell(Row:=2, Column:=4).Range 
respRange. Copy 

Set destRange = tcaDoc.Bookmarks("columnB").Range 

destRange.Collapse 

destRange.Paste 

udtProgress.Advance 

End Sub 
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' Model.cls 

VERSION 1.0 CLASS 
BEGIN 

Multiuser -1 True 
Persistable = 0 'NotPersistable 
DataBindingBehavior =^ 0 VbNone 
DataSourceBehavior =0 VbNone 
MTSTransactionMode = 0 'Not AnMTS Object 
END 

Attribute VB^Name - "Model" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = Trae 
Attribute VB_PredeclaredId False 
Attribute VB_Exposed = False 

Attribute VB_Ext_KEY = "SavedWithClassBuilder" /Tes" 
Attribute VB_Ext_KEY = "Top_Level" ,"No" 
Option Explicit 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer = 1 

' enable i/o 

Private mudtFile As File 

' handle for Model 

Private mdocModel As Document 

' the .doc file name of this model 
Private mstrDocFN As String 

' the .mdl file name of this model 
Private mstrConFN As String 

' has this model produced variants that were accepted? 
Private mblnlsFrozen As Boolean 

' comments about this model 
Private mstrComments As String 

' all of the variables for this model 
Private mudtCVariables As CVariables 

' all of the constraints for this model 
Private mudtCConstraints As CConstraints 
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' all of the clones generated by this model 
Private mudtCClones As CClones 

' the collection of checksums accepted by this model (these persist) 
Private mcolChecksums As Collection 

' the collection of checksums accepted by this model (these don't persist) 
Private mcolTempChecksums As Collection 

' the Prolog object 

Private mudtProlog As Prolog 

' needed for I/O 

Private mblnProcessChecksums As Boolean 
' is dirty? 

Private mblnlsDirty As Boolean 

' needed to save the model one last time after it's frozen 
Private mblnFreeze As Boolean 

Private Enum ModelRecordLayout 

mrLocalDatalndex = 1 ' long (takes 4 bytes) 

mrVariablelndex = 5 ' long 

mrConstraintlndex = 9 ' long 

mrChecksumlndex = 13 ' ' long 

mrLocalData =51' byte 

mrVariables = 201 ' variable length 

' the constraint data starts wherever the checksum data ends 

' the checksum data starts wherever the constraint data ends 
End Enum 

Private Sub Class_InitiaHze() 

Set mudtCVariables = New CVariables 

Set mudtCConstraints ^ New CConstraints 

Set mudtCClones = New CClones 

Set mcolChecksums = New Collection 

Set mcolTempChecksums = New Collection 

mblnlsDirty = True 

mblnFreeze = False 

End Sub 

Public Property Get FileName() As String 
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FileName = mstrDocFN 
End Property 

Public Property Let FileName(By Val strNew Value As String) 
mstrDocFN = strNewValue 
' create the FN for the constraint file 

mstrConFN = left(mstrDocFN, Len(mstrDocFN) - 4) & ".mdl" 
End Property 

Public Property Get IsFrozenQ As Boolean 

IsFrozen = mblnlsFrozen 
End Property 

Public Property Let IsFrozen(ByVal blnNewValue As Boolean) 

mblnlsFrozen = blnNewValue 
End Property 

Public Property Get CommentsQ As String 

Comments = mstrComments 
End Property 

Public Property Let Comments(ByVal strNewValue As String) 

If mstrComments <> strNewValue Then 

mstrComments = strNewValue 

mblnlsDirty = True 
End If 

End Property 

PubHc Property Get ClonesQ As CClones 

Set Clones = mudtCClones 
End Property 
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Public Property Get VariablesQ As CVariables 

Set Variables = mudtCVariables 
End Property 

Public Property Get ConstraintsQ As CConstraints 

Set Constraints = mudtCConstraints 
End Property 
Public Sub FreezeModelO 

If IsFrozen = False Then 

mblnFreeze = Trae 

IsFrozen = True 

WriteModel 
End If 

End Sub 

Public Sub AddChecksum(ByVal dblChecksum As Double) 

Call mcolChecksums.Add(dblChecksum) 
mblnlsDirty = True 

End Sub 

' resets the checksums if this model is a child 
Public Sub InitChecksumsQ 

Set mcolChecksums = New Collection 

End Sub 

Private Sub AddTempChecksum(ByVal dblChecksum As Double) 

Call mcolTempChecksums.Add(dblChecksum) 
End Sub 

' resets the temp checksums if this model is changed and variants are 
Public Sub InitTempChecksumsQ 
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Set mcolTempChecksums = New Collection 
End Sub 

Public Function ChecksumExists(ByVal dblChecksum As Double) As Boolean 
Dim vntChecksum As Variant 

' if no variables were checksummed, consider the variant unique 
If dblChecksum = 0 Then 

ChecksumExists = False 

Exit Function 
End If 

' check the persistent checksums (from accepted or discarded variants) 
For Each vntChecksum In mcolChecksums 
If vntChecksum = dblChecksum Then 
ChecksumExists - True 
Exit Function 
End If 
Next vntChecksum 

' check the checksums of variants produced in this session 
For Each vntChecksum In mcolTempChecksums 
If vntChecksum ^ dblChecksum Then 
ChecksumExists = True 
Exit Function 
End If 
Next vntChecksum 

ChecksumExists = False 

End Function 

PubHc Property Let IsDirty(ByVal blnNewValue As Boolean) 

mblnlsDirty = blnNewValue 
End Property 

Public Property Get IsDirtyQ As Boolean 
Dim mblnSaved As Boolean 

' As frozen models never get saved, they report is dirty 
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' when they are read in from disk. This fix causes them 

' to always report not IsDirty. 
' If IsFrozen Then 
IsDirty = False 
' Exit Property 
' End If 

If mdocModel Is Nothing Then 

mblnSaved = True 
Else 

mblnSaved ^ mdocModelSaved 
End If 

IfmblnlsDirty Or_ 
mudtCVariables.IsDirty Or 
mudtCConstraints.IsDirty Or _ 
mblnSaved = False Then 
IsDirty ^ True 

Else 

IsDirty = False 
End If 

End Property 

Public Property Let LastClone(ByVal intNewValue As Integer) 

mudtCClones.SeqNum = intNewValue 
End Property 

Public Property Get LastCloneQ As Integer 

LastClone = mudtCClones.SeqNum 
End Property 
' displays model 

PubUc Sub OpenDoc(ByVal udtWord As MSWord) 

Dim udtDS As New DocStatus 

' see if word doc is open 

If udtDS.IsOpen(mstrDocFN) = False Then 

Set mdocModel - udtWord.WordApp.Documents.Open(mstrDocFN, , mblnlsFrozen) 

End If 
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mdocModel.Activate 

End Sub 

' closes model 

Public Sub CloseDocO 

' save the model and the word doc 
Call WriteModel 

Dim udtDS As New DocStatus 

' close the word doc 

If udtDS.IsOpen(mstrDocFN) Then 

Call mdocModeLClose(False) ' don't save 

Set mdocModel = Nothing 
End If 

End Sub 

Public Sub CloseAUCloneDocsO 

Dim udtClone As Clone 

For Each udtClone In mudtCClones 

udtClone.CloseDoc 
Next udtClone 

End Sub 

Public Sub ReadModelQ 

Dim udtWAPI As New Win32API 

IfudtWAPLFileExists(mstrConFN) Then 
Set mudtFile ^ New File 
mudtFile.FileName = mstrConFN 
mblnProcessChecksums = False 

Call mudtFile.ReadFile(Me, mrLocalDatalndex, mrVariablelndex) 
Call mudtCVariables.ReadCollection(mstrConFN, mrVariablelndex, mrConstraintlndex) 
Call mudtCConstraints.ReadCollection(mstrConFN, mrConstraintlndex, 
mrChecksumlndex) 

mblnProcessChecksums = True 

Call mudtFile.ReadFile(Me, mrChecksumlndex, READ_UNTIL_EOF) 
Set mudtFile = Nothing 
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End If 



End Sub 

Public Sub ReadObjectsO 

Dim vField As Variant 

If mblnProcessChecksums Then 
On Error GoTo Beatit 
Do Until err.Number <> 0 

Call mudtFile.ReadField(vField) 
Call mcolChecksums.Add(vField) 
Loop 
Else 

Call mudtFile.ReadField(vField) ' returns the version stamp 
Call mudtFile.ReadField(vField) 
LastClone = vField 
Call mudtFile.ReadField(vField) 
IsFrozen = vField 
Call mudtFile.ReadField(vField) 
Comments = vField 
End If 

Beatit: 

Exit Sub 

End Sub 

Public Sub WriteModelO 

Dim IngEndPos As Long 
Dim udtDS As New DocStatus 
Dim udtProg As New Progress 

If IsDirty = False Then Exit Sub 

' If IsFrozen And mblnFreeze = False Then Exit Sub 

Call udtProg Jnit(2, "Saving the active model...") 

If udtDS.IsOpen(mstrDocFN) Then ' see if word doc is open 

If Not IsFrozen Then ' command will fail if doc is read-only 
mdocModel.Save 

End If 
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End If 

Set mudtFile = New File 
mudtFile.FileName = mstrConFN 
mblnProcessChecksums = False 

Call mudtFile. WriteFile(Me, True, mrLocalDatalndex, mrLocalData) 
udtProg. Advance 

IngEndPos - mudtCVariables.WriteCollection(mstrConFN, mrVariablelndex, mrVariables) 
IngEndPos = mudtCConstraints.WriteCollection(mstrConFN, mrConstraintlndex, IngEndPos) 
mblnProcessChecksums = True 

Call mudtFile.WriteFile(Me, False, mrChecksumlndex, IngEndPos) 

Set mudtFile ^ Nothing 

udtProg.Advance 

IsDirty = False 

mblnFreeze = False 

End Sub 

Public Sub WriteObjectsO 
Dim vntChecksum As Variant 

If mblnProcessChecksums Then 

For Each vntChecksum In mcolChecksums 
Call mudtFile,WriteField(vntChecksum) 

Next vntChecksum 
Else 

Call mudtFile.WriteField(mintVERSIONSTAMP) 
Call mudtFile.WriteField(LastClone) 
Call mudtFile. WriteField(IsFrozen) 
Call mudtFile. WriteField(Comments) 
End If 

End Sub 

' tests the constraints, doesn't care about unique solution 

Public Function ConstraintsOK(ByVal udtTestType As TestType, _ 
ByVal udtProlog As Prolog, blnUnderconstrained As Boolean, _ 
blnTestAborted As Boolean, strUnderconstrainedVN As String) As Boolean 

Dim strVN As String 
Dim strVal As String 

Dim udtCS As ConstraintSolver 

Set udtCS = InitConstraintSolver(2, udtTestType) 
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udtCS.Prolog = udtProlog 



blnUnderconstrained = False 
blnTestAborted = False 

Select Case udtCS.Solve(srTest) 
Case srPrologError, srNoSolutions 

ConstraintsOK = False 

Exit Function 
Case srPrologAborted 

blnTestAborted = Trae 

ConstraintsOK = False 

Exit Function 
Case srSuccess 

Do While udtCS.GetNextValue(strUnderconstrainedVN, strVal) 
If strVal = "_" Then ' it's underconstrained 
ConstraintsOK = False 
blnUnderconstrained True 
Exit Function 
End If 
Loop 
End Select 

ConstraintsOK = True 
End Function 

' implemented in the subclasses of Model 

PubHc Sub GenerateClones(ByVal udtWord As MSWord, ByVal udtProlog As 
ByVal intNumClones As Integer, ByVal bytDifference As Byte) 

End Sub 

' common code called by GenerateClones in the subclasses 

PubUc Sub SubstituteValues(ByVal objO As Object, _ 

ByVal udtWord As MSWord, ByVal udtProlog As Prolog, _ 
ByVal intNumClones As Integer, ByVal bytDifference As Byte, _ 
ByVal intStartPos As Integer) 

Dim udtClone As Clone 

Dim strPath As String 

Dim fRange As Range 

Dim intlndex As Integer 

Dim udtCS As ConstraintSolver 
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Dim udtSortedVs As C Variables 

Dim udtCon As Constraint 

Dim strVarName As String 

Dim strValue As String 

Dim intTry As Integer 

Dim blnSolFound As Boolean 

Dim blnUniqueSolFound As Boolean 

Dim udtType As VariableType 

CloseDoc ' close the model doc 

CommandBars("File").Controls("Exit").Enabled - False 
Randomize 

' do substitution of values into model doc 
strPath = ExtractPath(FileName) 
Dim udtProgress As New Progress 

Call udtProgress.Init(intNumClones, "Generating variants... 

' initalize the constraint solver 

Set udtCS = InitConstraintSolver(bytDifference) 

udtCS. Prolog = udtProlog 

' solve loop 

For intlndex = 1 To intNumClones 

' try lOx to get a unique sol, then give up 
For intTry - 1 To 10 
DoEvents ' allow abort 
If fhnProlog.Abort Then 

Exit Sub 
End If 

blnSolFound = False 

blnUniqueSolFound = False 

If udtCS.Solve(srGenerate) Then ' found a variant 

blnSolFound = True 
Else 

Exit For 
End If 

' variant found - is it unique? 

If Not ChecksumExists(udtCS. Checksum) Then 

blnUniqueSolFound = True 

Exit For 
End If 
Next intTry 
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' error if no solution found 
If Not blnSolFound Then 

Call MsgBox("No solution could be found for this constraint set", _ 
vbExclamation, "Error") 
udtProgress.Kill 
Exit Sub 
End If 

' error if unique solution could not be found 
If Not blnUniqueSolFound Then 

Call MsgBox("A unique solution could not be found for this constraint set after 10 
Lttempts." &_ 

" You may want to try again.", vbExclamation, "Error") 
udtProgress.Kill 
Exit Sub 
End If 

' add the new clone to the collection 

Set udtClone ^ Clones.Add(ExtractFileName(FileName), True) 

udtClone. Checksum = udtCS. Checksum 

Call AddTempChecksum(udtClone.Checksum) 

' add the new clone to the disposition list box 

With fhnTCA.lstDisposition 

Call .Addltem(udtClone.FileName) 

.ItemData(.ListCount - 1) = udtClone.index 
End With 

FileCopy FileName, strPath & udtClone.FileName 
Call udtClone.OpenDoc(udtWord, strPath) 
' do the substitution 

Set fRange = udtClone.CloneDoc.Content 
fRange.start = intStartPos 

With fRange.fmd 

While udtCS.GetNextValue(strVarName, strValue) 
.ClearFormatting 
.Text = strVarName 
.Replacement, ClearFormatting 

.Replacement.Text = FormatValue(strVarName, strValue) 
' this first execute needed so Word returns correct value 
.Execute replace:=wdReplaceAll, Forward :==True, _ 
MatchCase:=True 
Wend 
End With 

Dim i, n As Integer 
Dim nShapes As Long 
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n = udtClone.CloneDoc.InlineShapes.Count 



For i = 1 To n 

udtCS .Reset Valuelndex 

While udtCS.GetNextValue(strVarName, strValue) 
udtClone.CloneDoc.InlineShapes(i).Select 
Call MTTextSubstitution(strVarName, strValue) 
Wend 
Next 

udtClone.CloneDoc.Bookmarks("steml").Range.Copy 

If udtClone.CloneDoc.Bookmarks.Exists("tca_Stem") = True Then 
Dim stemRange As Range 

Set StemRange = udtClone.CloneDoc.Bookmarks("tca_Stem").Range 
stemRange.Paste 

udtClone.CloneDoc.Bookmarks.Addname:="tca_Stem", Range:=stemRange 
Else 

Call MsgBoxC'Model is missing TCA_Stem Bookmark!", vbExclamation, "Hey!") 
End If 

' trim hard returns at end of stem 
Dim retchr As String 
retchr = Chr$(13) 

With StemRange 
n = 0 

i = .Words.Count 

While .Words(i).Text = retchr And i > 1' Rob: I added the And part. Pete 
i = i- 1 

If .Words(i).Text = retchr Then 

n = n+ 1 
End If 
Wend 

If n > 0 Then 

.Words(. Words.Count - n + l).Delete Count:=n 
End If 
End With 

' callback to subclass to code unique to this model type 
Call objO.CreateVariant(udtClone) 
udtProgress.Advance 
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udtClone.CloseDoc 
Next intlndex 

End Sub 

' create, initialize constraint solver 

Private Function InitConstraintSolver(ByVal bytDifference As Byte, _ 

Optional ByVal udtTestType As TestType = tcTestAll) As ConstraintSolver 

Dim udtVar As Variable 
Dim udtCon As Constraint 
Dim udtVarString As VarString 
Dim udtCS As New ConstraintSolver 
Dim udtSortedVs As CVariables 

' add enabled variables to ConstraintSolver object, sorted by length, 
' strings first 

Set udtSortedVs = mudtCVariables.SortVarNamesByLength 

For Each udtVar In udtSortedVs 

If udtVar.Enabled Then 

Call udtCS.AddVariable(udtVar) 

End If 
Next udtVar 

' Add enabled constraints 
For Each udtCon In Constraints 
If udtCon.Enabled Then 

If UdtTestType = tcTestAll Or _ 

udtCon-ConstraintType = udtTestType - 1 Then 
Call udtCS.AddConstraint(udtCon) 
End If 
End If 
Next udtCon 

udtCS.DiffWeight = bytDifference 
Set InitConstraintSolver = udtCS 
End Function 

' formats all math variables for item presentation 
Private Function FormatValue(ByVal strVarName As String, _ 
ByVal strValue As String) As String 
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Dim udtV As Variable 
Dim udtVR As VarReal 
Dim udtVF As VarFraction 

For Each udtV In mudtCVariables 
IfudtV.Enabled Then 

If udtV.name = ExtractVarName(strVarName) Then 
Select Case udtV.Typ 
Case vtlnteger 

FormatValue = strValue 
Case vtReal 

Set udtVR-udtV 

FormatValue = FormatReal(strValue, _ 

udtVR,DecimalPlaces, udtVR.TrailingZeros) 
Case vtFraction 

Set udtVF = udtV 

If udtVF.MixedNumbers Then 

FormatValue = FormatFraction(strValue) 

Else 

FormatValue = strValue 
End If 
Case vtString 

FormatValue strValue 
Case vtUntyped 
FormatValue = FormatUntyped(strValue) 
End Select 
Exit For 
End If 
End If 
Next udtV 

End Function 

' takes the index off of a string variable name that is indexed 

Private Function ExtractVarName(ByVal strName As String) As String 

Dim varl As Variant 

varl = InStr(l, strName, ".") 

IfvarI>OThen 

ExtractVarName = lefl(strName, varl - 1) 
Else 

ExtractVarName = strName 
End If 
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End Function 



' formats reals for item presentation 

Private Function FormatReal(ByVal strReal As String, ByVal intPlaces As Integ 
ByVal blnTZeros As Boolean) As String 

Dim varPos As Variant 

Dim intLen As Integer 

Dim strl As String 

Dim strD As String 

Dim blnZeroFound As Boolean 

varPos = InStr(l, strReal, ".") 

' isolate strings on either side of decimal point 
If varPos = 0 Then 

strl = StrReal 
Else 

strl = Mid(strReal, 1, varPos - 1) 
StrD - Mid(strReal, varPos + 1, Len(strReal)) 
End If 

intLen = Len(strD) 

' pad or trim to intPlaces 
If intLen < intPlaces Then 

StrD = StrD & String(intPlaces - intLen, "0") 
Else 

If intLen > intPlaces Then 

StrD = left(strD, intPlaces) 
End If 
End If 

' get rid of trailing zeros if desired 
If blnTZeros - False Then 
Do 

blnZeroFound = False 

If right(strD, 1) - "0" Then 

StrD = left(strD, Len(strD) - 1) 

blnZeroFound = True 
End If 

Loop While blnZeroFound 
End If 

' reassemble string 
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IfLen(strD)>OThen 

FormatReal = strl & & strD 
Else 

FormatReal = strl 
End If 

End Function 

' formats fraction as mixed number for item presentation 

Private Function FormatFraction(ByVal strFraction As String) As String 

Dim intNum As Integer 
Dim intDen As Integer 
Dim intQuot As Integer 
Dim vnti As Variant 

vnti = InStr(strFraction, 7") 

' it's an integer 

If vnti 0 Then ' it's a whole number 

FormatFraction = strFraction 

Exit Function 
End If 

intNum ^ CInt(left(strFraction, vnti - 1)) 

intDen = CInt(right(strFraction, Len(strFraction) - vntI)) 

If intDen > 0 And Abs(intNum) > intDen Then 
intQuot = Int(intNum / intDen) 
intNum = intNum Mod intDen 

FormatFraction = Trim(Str(intQuot)) & " " & Trim(Str(Abs(intNum))) & 7" & 
Trim(Str(intDen)) 

Else 

FormatFraction = strFraction 
End If 

End Function 

Private Function FormatUntyped(ByVal strValue As String) 
Dim varl As Variant 

' see if the value is a list - if so, it will be in [] 
If left(strValue, 1) = And right(strValue, 1) - "]" Then 
' trim the brackets off 
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FormatUntyped = Mid(strValue, 2, Len(strValue) - 2) 
Else 

FormatUntyped = strValue 
End If 

End Function 

Private Function MTTextSubstitution(Source As String, dest As String) 
Dim Stat 

Selection.Copy 

'Init API, reset transform 

If MTUtil.CheckMTDLLVersion - 0 Then Exit Function 
MTXFormReset 

'first substitution 
Stat = MTXFonnAddVarSub( _ 
mtxfmSUBST_ALL, _ 

mtxfmVAR_SUB_PLAIN_TEXT, Source, 0, _ 

mtxfhiVAR_SUB_PLAIN_TEXT, dest, Len(dest), mtxfmSTYLE_NUMBER) 

If Stat <>0 Then 

MsgBox "MTXFormAddVarSub returned: " + Str(stat) 

Exit Function 
End If 

'do the substitution 
Stat = TransformGraphicEquation 
If Stat <>0 Then 
MsgBox "TransformGraphicEquation returned: " + Str(stat) 

Exit Function 
End If 

MTTermAPI 
Selection.Delete 
'Paste new equation 

Selection.Collapse Direction: =wdCollapseEnd 
Selection.PasteSpecialPlacement:=wdInLine 

End Function 
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' PrintModel.cls 
VERSION LO CLASS 
BEGIN 
Multiuser -1 True 
END 

Attribute VB_Name = 'TrintModer' 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB^Predeclaredld = False 
Attribute VB_Exposed = False 
Option Explicit 

Private mstrModelName As String 
Private mstrNow As String 
Private mintPage As Integer 
Private mintTab As Integer 

Public Property Let ModelName(ByVal strNewValue As String) 

mstrModelName = strNewValue 
End Property 

Public Sub PrintString(ByVal strS As String, ByVal intlndent As Integer) 
CheckPageBreak 

If Printer.CurrentY = 0 Then PrintHeading 
Printer.Print Space(intlndent * mintTab) & strS 
End Sub 

Private Sub PrintHeadingO 
Dim intY As Integer 

Printer.CurrentY = 1440 ' top margin 
Printer.Print Space(mintTab) & _ 

"Variables and constraints for model " & mstrModelName 
Printer.Print Space(mintTab) & mstrNow 
Printer.CurrentY = Printer.CurrentY + 100 
Printer.Line Step(0, 0)-Step(Printer. Width, 0) 
SkipLine 
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intY = Printer. CurrentY 
Printer. Current Y = Printer.Height - 1700 
Printer.Line Step(0, 0)-Step(Printer. Width, 0) 
Printer.CurrentY = Printer. CurrentY + 100 
Printer.CurrentX = 0 

Printer.Print Space(mintTab) & "Page " & Str(mintPage) 
Printer.CurrentY = intY 
mintPage = mintPage + 1 

End Sub 

Private Sub SkipLine() 

Printer.Print " " 
End Sub 

Private Sub CheckPageBreakQ 

Select Case Printer.PaperSize 

Case vbPRPSLetter, vbPRPSLetterSraall 

Call CheckOrientation(8.5, 11) 
Case vbPRPSTabloid 

Call CheckOrientation(ll, 17) 
Case vbPRPSLedger 

Call CheckOrientation(17, 1 1) 
Case vbPRPSLegal 

Call CheckOrientation(8.5, 14) 
End Select 

End Sub 

Private Sub CheckOrientation(ByVal sngWidth As Single, _ 
ByVal sngHeight As Single) 

' convert inches to twips 
sngWidth = sngWidth * 1440 
sngHeight = sngHeight * 1440 

If Printer. Orientation = vbPRORPortrait Then 
If Printer.CurrentY >= sngHeight - 2200 Then 

Printer.NewPage 
End If 

Else 

If Printer.CurrentY >= sngWidth - 2200 Then 
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Printer .NewPage 
End If 
End If 

5 End Sub 

Private Sub Class_Initialize() 

Printer.FontSize = 1 1 
mstrNow = Now 
mintPage = 1 
10 mintTab = 4 

End Sub 

Private Sub Class_Terminate() 
Printer.EndDoc 

15::; 
i: End Sub 
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' Progress.cls 
VERSION 1.0 CLASS 
BEGIN 

Multiuser -1 True 
5 END 

Attribute VB_Name = "Progress" 

Attribute VB_GlobalNameSpace = False 

Attribute VB_Creatable - True 

Attribute VB_PredeclaredId = False 
1 0 Attribute VB_Exposed - False 

' class to give visual indication of progress 

Option Explicit 

Private mintStepSize As Integer 
' pulls up form 

1 5 Public Sub Init(By Val intNumlncrements As Integer, _ 
Q \ Optional ByVal strCaption As String) 

a ^ If intNumlncrements = 0 Then ' prevent divide by 0 
4 \ Beep 
2a^^' Exit Sub 

End If 



25'^ 



mintStepSize = 500 / intNumlncrements 

frmProgress.prbProgressBar.Max = mintStepSize * intNumlncrements 

If Len(strCaption) > 0 Then 

frmProgress.lblProgress ^ strCaption 
End If 



3 0 frmProgress . Show 

fimProgress.Refresh 

End Sub 

' bumps the progress bar to the next increment. When the progress 
35 'bar is fully advanced, the form is unloaded. 
PubUc Sub AdvanceQ 

Dim intStop As Integer 



40 



With frmProgress.prbProgressBar 
If .Value = .Max Then 
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Exit Sub 
End If 

intStop = .Value + mintStepSize 
Do Until .Value = intStop 
.Value = .Value + 1 
If. Value = . Max Then 
Unload fhnProgress 
Exit Sub 
End If 
Loop 
End With 

End Sub 

Public Sub AbsoluteAdvance(ByVal intNew Value As Integer) 

frmProgress.prbProgressBar. Value = intNewValue * mintStepS 
End Sub 

Public Sub KillO 

Unload frmProgress 
End Sub 
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' Prolog.cls 

VERSION 1.0 CLASS 
BEGIN 

MultiUse = 0 'False 
Persistable = 0 'NotPersistable 
DataBindingBehavior ^ 0 'vbNone 
DataSourceBehavior = 0 VbNone 
MTSTransactionMode =0 'Not AnMTS Object 
END 

Attribute VB_Name = "Prolog" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable - True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = True 

Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes" 
Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 
Option Explicit 

Private Declare Function StartProlog4Session Lib "prlghlapi.dll" _ 

(ByVal strP4FN As String) As Long 
Private Declare Function EndProlog4Session Lib "prlghlapi.dll" () As Long 
Private Declare Function GetHLAPIVersion Lib "prlghlapi.dU" () As String 
Private Declare Function VB GetHLAPIVersion Lib "prlghlapi.dll" () As String 
Private Declare Function SolveConstraintOrdered Lib "prlghlapi.dll" _ 

(ByVal Constraint As String, ByVal SolutionOrder As Long) As Long 
Private Declare Function SolveConstraintRandomly Lib "prlghlapi.dll" _ 

(ByVal Constraint As String) As Long 
Private Declare Function SolveConstraintOrderedNSolns Lib "prlghlapi.dll" _ 

(ByVal Constraint As String, ByVal SolutionOrder As Long, _ 

ByVal NumSols As Long) As Long 
Private Declare Function IsFuUyConstrained Lib "prlghlapi.dll" _ 

(ByVal Constraint As String) As Long 
Private Declare Function GetValue Lib "prlghlapi.dU" _ 

(ByVal strVarName As String) As Long 
Private Declare Function VBGetValue_string Lib "prlghlapi.dll" _ 

(ByVal udtPtr As Any) As String 
Private Declare Function VBPrintAUVarVals Lib "prighlapi.dll" () As String 
Private Declare Function SetSolnDiffWt Lib "prlghlapi.dll" _ 

(ByVal Weight As Long) As Long 
Private Declare Function SetProloglnterruptFile Lib "prlghlapi.dU" _ 

(ByVal strFN As String) As Long 

'Keep the constants in sync with appropriate values in prlghlapi.h 
' Solution-Orders; 
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Private Enum PrologOrder 

prDontCareOrder = 0 

prDifferentOrder = 10 

prLikeOrder = 20 

prRandomOrder = 30 

prUniqueOrder = 40 
End Enum 

Private Enum PrologType 

prValUnknown = 0 

prVallnteger = 10 

prValRationalFloat= 12 

prValRationalFraction = 13 

prVallrrational = 14 

prValReal=15 

prValString = 20 

prValList = 25 

prValFunctor = 30 

prValSymbol = 35 

prValVar-100 
End Enum 

Private Enum PrologErrors 

prErrlnitialization = -10 

prErrlntegerraintTooLong = -15 

prErrGettingTerm = -20 

prErrMakingFunctor = -25 

prErrlnvalidlnterval = -30 

prErrArityTooMany = -35 

prErrParse = -40 

prErrNuUTerm = -45 
End Enum 

' used to hold all strings for the Prolog 
Private mcolVNs As Collection 

Private mstrDelimit As String 

Private mintNumSols As Integer 

Event Finished(ByVal IngRet As Long) 

Private Sub Class_Initialize() 

Set mcolVNs = New Collection 



Set gProlog = Me ' gProlog is defined in Timer.bas 
Dim IngRet As Long 

' if this file exists, interrupt prolog processing 
IngRet - SetPrologInterruptFile("c:\halt.tca") 

End Sub 

Private Sub Class_Terminate() 

Set gProlog = Nothing 
End Sub 

Public Property Get VersionQ As String 

Version = GetHLAPIVersion() 
End Property 

' sets the degree of difference in the variants. Range is 0 to 2. 
Public Property Let DiffWeight(ByVal bytDifference As Byte) 

Call SetSolnDiffWt(CLng(bytDifference)) 

End Property 

Public Function StartPrologQ As Boolean 

ChDir App.Path ' set path to apphcation dir for hlp41ib.p4 file 
StartProlog = CBool(StartProlog4Session("hlp41ib.p4")) 

End Function 

Public Function EndPrologQ As Boolean 

ChDir App.Path ' set path to apphcation dir for hlp41ib.p4 file 
EndProlog = CBool(EndProlog4Session()) 

End Function 

Public Sub AddVariable(ByVal strS As String) 
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If Len(strS) > 0 Then ' it's not an untyped variable 

Call mcolVNs.Add(strS) 

mstrDelimit = "end_var_defs," 
End If 

End Sub 

Public Sub AddConstraint(ByVal strS As String) 

Call mcolVNs.Add(mstrDelimit & strS) 
mstrDelimit = 

End Sub 

Public Sub SolveConstraintsRandomlyO 

SolveAsync ' in Timer.bas - must be in a standard module 
End Sub 

Public Sub SolveConstraintsAsyncQ 

Dim StrS As String 
Dim IngRet As Long 

IngRet = -1 ' default to error condition 

If mcolVNs. Count > 0 Then ' there's something for Prolog to chew 
strS = BuildStringO 

ChDir App.Path ' set path to application dir for hlp41ib.p4 file 
IngRet = SolveConstraintRandomly(strS) ' call Prolog 
End If 

RaiseEvent Finished(lngRet) 
Set mcolVNs = New Collection 
End Sub 

Private Function RandomNumSolsQ As Integer 
Randomize 

RandomNumSols = 10 * Rnd - 0.5 

If RandomNumSols = 0 Then RandomNumSols = 1 
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End Function 

Private Sub Advance(ByVal IngRet As Long) 

Dim inti As Integer 

5 For intI 1 To IngRet 

NextSolution 
Next intI 

End Sub 

10 ' gets the next solution, returns true if one exists, false if it doesn't 
Private Function NextSolutionQ As Boolean 

ChDir App.Path ' set path to apphcation dir for hlp4hb.p4 file 
NextSolution = SolveConstraintOrderedNSolns(vbNullString, _ 
prUniqueOrder, mintNumSols) 

11=, 

End Function 

Public Property Get PrintAUValsQ As String 

PrintAllVals = VBPrintAUVarVals 

201^^ End Property 

' get the values associated with each solution 

Public Property Get Value(ByVal strVN As String) As String 

J-:: Dim IngPtr As Long 
2^^^ Dim strT As String 

ChDir App.Path ' set path to application dir for hlp41ib.p4 file 
IngPtr = GetValue(strVN) ' returns a pointer to the variable 

30 If IngPtr Then ' to handle untyped variables that have no constraint, and therefore no value 

StrT = VBGetValue_string(lngPtr) ' returns a string 

Value = Left(strT, Len(strT) - 1) ' trim off the null delimiter 
Else 
Value = 
35 End If 

End Property 
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Private Function BuildString() As String 

Dim varStr As Variant 
Dim strS As String 

For Each varStr In mcoIVNs 
5 strS = strS & varStr & ", " 

Next varStr 

' trim off the last comma and space 
StrS = Left(strS, Len(strS) - 2) 
10 'add a period 

StrS - StrS & "." 

BuildString = strS 

15 End Function 

Public Sub ShowStringO 

^\ Dim StrS As String 

i:: StrS = BuildStringO 
20,t) ' Call MsgBox(strS, , "Prolog string is:") 

End Sub 
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• PSMODEL.cls 
VERSION 1.0 CLASS 
BEGIN 

Multiuser -1 True 

Persistable = 0 'NotPersistable 

DataBindingBehavior = 0 VbNone 

DataSourceBehavior =0 VbNone 

MTSTransactionMode = 0 'NotAnMTSObject 
END 

Attribute VB_Name - "SMCModel" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Implements Model 

Dim mudtModel As Model 
Dim lastStart As Integer 

Private Sub Class_Initialize() 

Set mudtModel = New Model 

End Sub 

' Delegated to Class Model 

Public Property Get Model_FileName() As String 

Model_FileName = mudtModel. FileName 

End Property 

' Delegated to Class Model 

Public Property Let Model_FileName(ByVal strNewValue As String) 

mudtModeLFileName = strNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_IsFrozen() As Boolean 
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Model_IsFrozen = mudtModel.IsFrozen 
End Property 

' Delegated to Class Model 

Public Property Let Model_IsFrozen(ByVal blnNewValue As Boolean) 

mudtModel.IsFrozen = blnNewValue 
End Property 

' Delegated to Class Model 

Public Sub Model_AddChecksum(ByVal dblChecksum As Double) 

Call mudtModeLAddChecksum(dblChecksum) 
End Sub 

' Delegated to Class Model 

Public Sub Model_InitChecksums() 

mudtModel Init Checksums 

End Sub 

' Delegated to Class Model 

Public Sub Model_InitTempChecksums() 

mudtModel. InitTempChecksums 

End Sub 

' Delegated to Class Model 

Public Function Model_ChecksumExists(ByVal dblChecksum As Double) As Boolean 

Model_ChecksumExists = mudtModel.ChecksumExists(dblChecksum) 
End Function 
' Delegated to Class Model 

Public Property Get Model_Comments() As String 

Model_Comments = mudtModel. Comments 
End Property 
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' Delegated to Class Model 

Public Property Let Model_Comments(By Val strNew Value As String) 

mudtModel. Comments = strNew Value 
End Property 

' Delegated to Class Model 

Public Property Get Model_Clones() As CClones 

Set Model_Clones = mudtModel. Clones 

End Property 

' Delegated to Class Model 

Public Property Get Model__Variables() As CVariables 

Set Model^Variables = mudtModel Variables 
End Property 

' Delegated to Class Model 

Public Property Get Model_Constraints() As CConstraints 

Set Model_Constraints = mudtModel.Constraints 
End Property 

' Delegated to Class Model 

Public Property Let Model_IsDirty(ByVal blnNewValue As Boolean) 

mudtModel. IsDirty blnNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_IsDirty() As Boolean 

Model_IsDirty = mudtModel.IsDirty 

End Property 

' Delegated to Class Model 

Public Property Let Model_LastClone(ByVal intNewValue As Integer) 
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mudtModel.LastClone = intNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_LastClone() As Integer 

Model_LastClone = mudtModel.LastClone 
End Property 

' Delegated to Class Model 
Public Sub Model_FreezeModel() 

Call mudtModel.FreezeModel 

End Sub 

' Delegated to Class Model 

Public Sub Model_^OpenDoc(ByVal udtWord As MSWord) 

Call mudtModel.OpenDoc(udtWord) 
End Sub 

' Delegated to Class Model 
Public Sub Model_CloseDoc() 

Call mudtModel.CloseDoc 

End Sub 

' Delegated to Class Model 

Public Sub Model_CloseAllCloneDocs() 

Call mudtModeLCloseAllCloneDocs 

End Sub 

' Delegated to Class Model 
Public Sub ModeLReadModelO 

mudtModel.ReadModel 

End Sub 
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' Delegated to Class Model 
Public Sub Model_ReadObjects() 

mudtModel .ReadObj ects 

End Sub 

' Delegated to Class Model 
Public Sub Model_WriteModel() 

mudtModel.WriteModel 

End Sub 

' Delegated to Class Model 
Public Sub Model_WriteObjects() 

mudtModel. WriteObj ects 

End Sub 

' Delegated to Class Model 

Public Function Model__ConstraintsOK(ByVal udtTestType As TestType, _ 
ByVal udtProlog As Prolog, blnUnderconstrained As Boolean, _ 
blnTestAborted As Boolean, strUnderconstrainedVN As String) As Boolean 

Model_ConstraintsOK = mudtModel. ConstraintsOK(udtTestType, udtProlog, _ 
blnUnderconstrained, blnTestAborted, strUnderconstrainedVN) 

End Function 

' implemented here 

Public Sub Model_GenerateClones(ByVal udtWord As MSWord, ByVal udtProlog As Prologs 
ByVal intNumClones As Integer, ByVal bytDifference As Byte) 

Call mudtModel. Substitute Values(Me, udtWord, udtProlog, intNumClones, _ 
bytDifference, 50) 

End Sub 

' Delegated to Class Model 

Public Sub Model_SubstituteValues(ByVal objO As Object, _ 
ByVal udtWord As MSWord, ByVal udtProlog As Prolog, 
ByVal intNumClones As Integer, ByVal bytDifference As Byte, _ 
ByVal intStartPos As Integer) 
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End Sub 



Public Sub CreateVariant(ByVal udtClone As Clone) 

With udtClone. CloneDoc.Bookmarks 
If .Exists("tca_RespA") = False Or _ 
.Exists("tca_RespB") = False Or _ 
.Exists("tca_RespC") - False Or _ 
.ExistsC'tca_RespD") = False Or _ 
.Exists("tca_RespE") = False Or _ 
.Exists("tca_Key") - False Then 

Call MsgBox("Model is missing a TCA Bookmark!", vbExclamation, "Hey!") 
Exit Sub 
End If 
End With 

Dim nchoices As Integer 
Dim lowerbound As Integer 
Dim upperbound As Integer 

nchoices = 5 
lowerbound = 1 
upperbound = 8 

Dim resp(lO) As String 
Dim used(lO) As Integer 

resp(O) = udtClone.CloneDoc.Bookmarks("key").Range.Text 
Dim i As Integer 

For i ^ lowerbound To upperbound 
used(i) = 0 

resp(i) = udtClone.CloneDoc3ookmarks("resp" & Format(i)).Range.Text 
Next 

Dim nselected As Integer 
nselected = 0 

Dim mumber As Integer 
Dim mumbers(lO) As Integer 

While (nselected < upperbound) 
mumber = (upperbound - lowerbound + 1) * Rnd + lowerbound - 0.5 
If (mumber > upperbound) Then 
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mumber = upperbound 
End If 

If (used(mumber) = 0) Then 

used(mumber) = 1 

nselected = nselected + 1 

mumbers(nselected) = mumber 
End If 
Wend 

Dim unsorted(lO) As Integer 
unsorted(O) = 0 
nselected - 0 

Dim j As Integer 
Dim n As Integer 

Dim crStr As String 

Dim tabcrStr As String 

crStr-Chr(13) 

tabcrStr = Chr(9)&Chr(l 3) 

For i lowerbound To upperbound 
If resp(mumbers(i)) <> tabcrStr And _ 
resp(mumbers(i)) <> crStr And 
Mid(resp(mumbers(i)), 1, 10) <> "Distractor" Then 

n = 0 

For j = 0 To nselected 
If IsNumeric(resp(mumbers(i))) = Trae And _ 
IsNumeric(resp(unsorted(j))) = True And _ 
Asc(resp(mumbers(i))) <> 36 Then ' 36 is the $ sign 
If Val(resp(mumbers(i))) = Val(resp(unsorted(j))) Then 
If Asc(resp(mumbers(i))) <> 1 Then 
n=l 
Exit For 
End If 
End If 
Else 

If resp(mumbers(i)) = resp(unsorted(j)) Then 
If Asc(resp(mumbers(i))) <> 1 Then 
n= 1 
Exit For 
End If 
End If 
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End If 
Next 



Ifn = OThen 
nselected = nselected + 1 
unsorted(nselected) = mumbers(i) 
If nselected = nchoices - I Then 
If nselected = upperbound Then 

Exit For 
End If 
End If 
End If 
Next 

For i = 0 To nselected 

used(i) = 0 
Next 

Dim sorted(lO) As Integer 
Dim respl, resp2 As String 
Dim vail, val2 As Variant 

For i = 0 To nselected 
For j = 0 To nselected 
If(usedG) = 0) Then 
sorted(i) = unsorted(j) 

Exit For 
End If 
Next 

For j ^ 0 To nselected 
If(usedG) = 0) Then 

respl = resp(unsorted(j)) 
resp2 = resp(sorted(i)) 

Ifleft(respl, 1) = "$" Then 

vail = Val(right(respl, Len(respl) - 1)) 
Else 

vail = Val(respl) 
End If 

Ifleft(resp2, 1)-"$" Then 
val2 = Val(right(resp2, Len(resp2) - 1)) 
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Else 

val2 - Val(resp2) 
End If 

If(vall<val2) Then 
sorted(i) = unsorted(j) 

End If 

End If 

Next 

used(n) = 1 
Next 

For i = 0 To nselected 

If sorted(i) = 0 Then 
Exit For 

End If 
Next 

Dim min, max As Integer 

min = i - 4 

If min < 0 Then 

min = 0 
End If 

max = i 

If max > nselected - 4 Then 

max = nselected - 4 
End If 

If max < 0 Then 

max = 0 
End If 

Dim is tart As Integer 
Dim iEnd As Integer 

If max > 0 And max + 4 <= nselected Then 
iStart = lastStart 
While iStart = lastStart 

iStart = (max - min + 1) * Rnd + min - 0.5 
Wend 
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lastStart - iStart 
iEnd = iStart + nchoices - 1 
Else 
iStart = 0 

If nselected > 4 Then 

iEnd = 4 
Else 

iEnd = nselected 
End If 

lastStart = iStart 
End If 

Dim respRange As Range 
Dim choice As String 
Dim key As String 

n-1 

For i = iStart To iEnd 
choice = Mid("ABCDE", n, 1) 

Ifsorted(i) = OThen 

udtClone.CloneDoc.Bookmarks("key").Range.Copy 
Else 

udtClone.CloneDoc.Bookmarks("resp" & Format(sorted(i))).Range.Copy 
End If 

Set respRange = udtClone.CloneDoc.Bookmarks("tca_Resp" & choice).Range 
respRange.Paste 

respRange.Borders.Enable = False 
respRange.Borders JnsideLineStyle = wdLineStyleNone 

udtClone.CloneDoc.Bookmarks.Add name:="tca__Resp" & choice, Range :=respRange 
respRange.InsertBefore Text:=choice & ". " 

Ifsorted(i)-OThen 

key = choice 

udtClone.key = choice 
End If 

n = n+ 1 
Next 

For i = nselected + 1 To nchoices - 1 
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choice = Mid("ABCDE", i + 1, 1) 

Set respRange ^ udtClone.CloneDoc.Bookinarks("tca_Resp" & choice).Range 
respRange.Text = "[NO VALUE]" & Chr(13) & Chr(lO) 

udtClone.CIoneDoc.Bookmarks.Add name:="tca_Resp" & choice, Range:=respRan 
respRange. Inserts efore Text:==choice & ". " 
Next 

Dim keyRange As Range 

Set keyRange = udtClone.CloneDoc.Bookmarks("tca_Key").Range 
keyRange JnsertBefore Text:="Key is " & key 

End Sub 
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' QCModel.cls 
VERSION 1.0 CLASS 
BEGIN 

Multiuser -1 Trae 
Persistable = 0 'NotPersistable 
DataBindingBehavior ~ 0 VbNone 
DataSourceBehavior = 0 VbNone 
MTSTransactionMode = 0 'No tAnMTS Object 
END 

Attribute VB_Name = "QCModel" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Implements Model 

Dim mudtModel As Model 

Private Sub Class_Initialize() 

Set mudtModel = New Model 

End Sub 

' Delegated to Class Model 

Public Property Get Model_FileName() As String 

Model_FileName ^ mudtModelFileName 

End Property 

' Delegated to Class Model 

Public Property Let Model_FileName(ByVal strNewValue As String) 

mudtModel. FileName = strNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_IsFrozen() As Boolean 
Model IsFrozen = mudtModel. IsFrozen 
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End Property 

' Delegated to Class Model 

Public Property Let Model_IsFrozen(ByVal blnNewValue As Boolean) 

mudtModel.IsFrozen = blnNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_Comments() As String 

Model_Comments = mudtModel. Comments 
End Property 

' Delegated to Class Model 

Public Property Let Model_Comments(ByVal strNewValue As String) 

mudtModelComments = strNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_Clones() As CClones 

Set Model_Clones = mudtModel.Clones 

End Property 

' Delegated to Class Model 

Public Property Get Model_Variables() As CVariables 

Set Model_Variables = mudtModel.Variables 
End Property 

' Delegated to Class Model 

Public Property Get Model_Constraints() As CConstraints 

Set Model_Constraints = mudtModel. Constraints 
End Property 
'Delegated to Class Model 
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Public Sub Model_AddChecksum(ByVal dblChecksum As Double) 

Call mudtModeLAddChecksum(dblChecksum) 
End Sub 

' Delegated to Class Model 

Public Sub Model_InitChecksums() 

mudtModelJnitChecksums 

End Sub 

' Delegated to Class Model 

Public Sub Model_InitTempChecksums() 

mudtModel.InitTempChecksums 
End Sub 

'Delegated to Class Model 

Public Function Model_ChecksumExists(ByVal dblChecksum As Double) As Boolean 

Model^ChecksumExists = mudtModel.ChecksumExists(dblChecksum) 
End Function 
' Delegated to Class Model 

Public Property Let Model JsDirty(ByVal blnNewValue As Boolean) 

mudtModel.IsDirty = blnNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_IsDirty() As Boolean 

Model_IsDirty = mudtModel.IsDirty 

End Property 

' Delegated to Class Model 

Public Property Let Model_LastClone(ByVal intNewValue As Integer) 
mudtModel.LastClone = intNewValue 
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End Property 

' Delegated to Class Model 
Public Sub Model_FreezeModel() 

Call mudtModel.FreezeModel 

End Sub 

' Delegated to Class Model 

Public Property Get Model_LastClone() As Integer 

Model_LastClone = mudtModel.LastClone 
End Property 

' Delegated to Class Model 

Public Sub Model_OpenDoc(ByVal udtWord As MSWord) 

Call mudtModeLOpenDoc(udtWord) 
End Sub 

' Delegated to Class Model 
Public Sub Model_CloseDoc() 

Call mudtModelCloseDoc 

End Sub 

' Delegated to Class Model 

Public Sub Model_CloseAllCloneDocs() 

Call mudtModel.CloseAUCloneDocs 

End Sub 

' Delegated to Class Model 
Public Sub ModeLReadModelQ 

mudtModeLReadModel 

End Sub 

' Delegated to Class Model 
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Public Sub Model_ReadObjects() 

mudtModelReadObj ects 
End Sub 

* Delegated to Class Model 
5 Public Sub Model_WriteModel() 

mudtModel.WriteModel 

End Sub 

' Delegated to Class Model 
Public Sub Model_WriteObjects() 

1 0 mudtModel WriteObjects 

End Sub 

' Delegated to Class Model 
'^i Public Function Model__ConstraintsOK(ByVal udtTestType As TestType, _ 
^ ByVal udtProlog As Prolog, blnUnderconstrained As Boolean, _ 
15|j blnTestAborted As Boolean, strUnderconstrainedVN As String) As Boolean 

m Model_ConstraintsOK = mudtModel.ConstraintsOK(udtTestType, udtProlog, _ 
I blnUnderconstrained, blnTestAborted, strUnderconstrainedVN) 

■^f End Function 

"C^^ ' implemented here 

Public Sub Model_GenerateClones(ByVal udtWord As MSWord, ByVal udtProlog As Prolog, 
ByVal intNumClones As Integer, ByVal bytDifference As Byte) 

Call mudtModel. SubstituteValues(Me, udtWord, udtProlog, intNumClones, _ 
bytDifference, 275) 

End Sub 

' Delegated to Class Model 

Public Sub Model_SubstituteValues(ByVal objO As Object, _ 
ByVal udtWord As MSWord, ByVal udtProlog As Prolog, _ 
ByVal intNumClones As Integer, ByVal bytDifference As Byte, _ 
ByVal intStartPos As Integer) 
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End Sub 



Public Sub Create Variant(ByVal udtClone As Clone) 

Dim mumber As Integer 
Dim sLen As Integer 
Dim columnRange As Range 
Dim columnAValStr As String 
Dim columnB ValStr As String 

With udtClone.CloneDoc 

mumber = .Tables(2).Rows.Count * Rnd + 0.5 
.Tables(2).Cell(Row;=mumber, Column:=l).Range.Copy 
columnAValStr = .Tables(2).Cell(Row:=mumber, Column:=2).Range.Text 

sLen = Len(columnAValStr) 
If sLen > 1 Then 

columnAValStr = left(columnA ValStr, sLen - 1) 
End If 

Set columnRange = .Bookmarks("tca_ColumnA").Range 
columnRange.Paste 

mumber = .Tables(3),Rows. Count * Rnd + 0.5 
.Tables(3).Cell(Row:=mumber, Column:=l).Range.Copy 
columnBValStr = ,Tables(3).Cell(Row:=mumber, Column:=2).Range.Text 

sLen = Len(columnB ValStr) 
If sLen> 1 Then 

columnBValStr = left(columnB ValStr, sLen - 1) 
End If 

Set columnRange = .Bookmarks("tca_ColumnB"). Range 
columnRange.Paste 

If .Tables(l).Columns.Count = 4 Then ' fixes weird behavior if only 1 row in 

.Tables(l).Cell(Row:=l,Column:-4).Delete 

.Tables(l).Cell(Row:=l,Column:=3).Delete 
End If 

Dim key As String 
Dim columnAValue 
Dim columnB Value 
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If IsNumeric(columnAValStr) = True And _ 
IsNumeric(columnBValStr) = True Then 

coIumnA Value = Val(columnAValStr) 
columnB Value = Val(columnB ValStr) 

If columnAValue > columnB Value Then 
key -"A" 

Elself columnB Value > columnAValue Then 
key-"B" 

Elself columnAValue = columnB Value Then 

key = "C" 
End If 

End If 

End With 

Dim keyRange As Range 

Set keyRange ^ udtClone.CloneDoc.Bookmarks("tca_Key").Range 
Ifkey = "" Then 

keyRange.InsertBefore Text:="TCA cannot determine the key" 
Else 

keyRange.InsertBefore Text:="Key is " & key 
End If 

udtClone.key = key 
End Sub 
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' StringSolver.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = 0 'False 

Persistable = 0 *NotPersistabIe 

DataBindingBehavior = 0 VbNone 

DataSourceBehavior ^0 VbNone 

MTSTransactionMode = 0 'NotAnMTSObject 
END 

Attribute VB_Name = "StringSolver" 
Attribute VB^GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Dim mudtVS As VarString 

Dim mcolValues As Collection 

Public Property Let StringVariable(ByVal udtNewValue As VarString) 

Set mudtVS = udtNewValue 
End Property 

Public Property Get RandomValueCollectionQ As Collection 

Dim udtSS As Substring 
Dim strS As String 
Dim varS As Variant 

Set mcolValues = New Collection 

strS = mudtVS. StringCollectionJtem(GetRandomlndex) 

If mudtVS.IsIndexed Then 

Set udtSS = New Substring 

udtSS. Delimiter = mudtVS. Delimiter 

udtSS.StringValue = strS 

For Each varS In udtSS.StringCoUection 
Call mcolValues.Add(varS) 

Next varS 
Else 
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Call mcolValues,Add(strS) 
End If 

Set Random ValueCollection = mcolValues 
End Property 

Private Function GetRandomIndex() As Integer 
Dim inti As Integer 

inti = mudt VS. StringCoUection. Count ^ Rnd + 0.5 

' Seems to produce an out-of-range value sometimes. 
' This will fix it. 
IfintK 1 Then inti = 1 

If inti > mudtVS.StringCollection.Count Then inti = mudtVS. StringCoUection. Count 
GetRandomlndex = inti 
End Function 
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' StringSolverx.cls 
VERSION 1.0 CLASS 
BEGIN 
Multiuser -1 'True 
5 END 

Attribute VB_Name = "StringSolver" 
Attribute VB_GIobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
1 0 Attribute VB_Exposed = False 
Option Explicit 

Private mcolSV As Collection 

Private Sub Class_Initialize() 

Set mcolSV = New Collection 

End Sub 
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' SubString.cls 
VERSION 1.0 CLASS 
BEGIN 
Multiuser -1 'Trae 
END 

Attribute VB_Name = ''Substring" 
Attribute VB_GlobalNameSpace ^ False 
Attribute VB_Creatable - True 
Attribute VB_PredeclaredId - False 
Attribute VB_Exposed = False 
Option Explicit 

Private mstrDelimiter As String 
Private mstrString As String 
Private mcolStr As Collection 
Private Sub Class_Initialize() 

Set mcolStr = Nev^ Collection 
End Sub 

Public Property Let Delimiter(ByVal strNewValue As String) 

mstrDelimiter = strNewValue 
End Property 

' use this to convert a concatenated string to a collection 
Public Property Let StringValue(ByVal strNewValue As String) 

mstrString = strNewValue 

End Property 

' or use this to convert a collection to a concatenated string 

Public Property Let StringCollection(ByVal colNewValue As Collection) 

Set mcolStr = colNewValue 

End Property 
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' converts collection into concatenated string 
Public Property Get StringValueQ As String 

Dim varS As Variant 
Dim strS As String 

' build new string 

For Each varS In mcolStr 

strS strS & varS & mstrDelimiter 
Next varS 

' trim last character 
IfLen(strS)>OThen 

StringValue = left(strS, Len(strS) - 1) 
End If 

End Property 

' converts concatenated string into a collection 
Public Property Get StringCoUectionQ As Collection 

Dim colC As New Collection 
Dim inti As Integer 

For intI ^ I To NumSubStrings 

Call colC.Add(GetSubString(intI)) 
Next intI 

Set StringCollection = colC 
End Property 

' returns the number of substrings in this string 
Public Property Get NumSubStringsQ As Integer 

Dim intD As Integer 
Dim intI As Integer 
Dim varS As Variant 

If Len(mstrString) = 0 Then 

NumSubStrings = 0 

Exit Property 
End If 

For intI = 1 To Len(mstrString) 
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If Mid(mstrString, inti, 1) = mstrDelimiter Then 

intD = into + 1 
End If 
Next inti 

NumSubStrings - intD + 1 
End Property 

Public Sub AddSubString(ByVal strNewValue As String) 

Call mcolStr,Add(strNewValue) 
End Sub 

' parses the substring from the string depending on intlndex 

Public Function GetSubString(ByVal intlndex As Integer) As String 

' see if index is valid for the current string 
If NumSubStrings < intlndex Then 

GetSubString = "" 

Exit Function 
End If 

' index into the string using delimiter 
Dim varll As Variant 
Dim varI2 As Variant 
Dim intCount As Integer 

varI2 = 0 

Do 

varll = varI2 

varI2 InStr(varIl + 1, mstrString, mstrDelimiter) 
intCount = intCount + 1 
IfvarI2 = 0Then 

varI2 = Len(mstrString) + 1 
End If 

Loop Until intCount = intlndex 

GetSubString - Mid(mstrString, varll + 1, varI2 - varll - 1) 
End Function 
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' Value.cls 

VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l True 
END 

Attribute VB_Name = "Value" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Dim mstrVariableName As String 

Dim mstrValue As String 

Dim mblnChecksum As Boolean 

Dim mstrPrologString As String 

Dim mudtVariableType As VariableType 

Public Property Get VariableNameQ As String 

VariableName = mstrVariableName 

End Property 

Public Property Let VariableName(ByVal strNew Value As String) 

mstrVariableName = strNewValue 
End Property 

Public Property Get ValueQ As String 

Value = mstrValue 
End Property 

Public Property Let Value(By Val strNewValue As String) 

mstrValue = strNewValue 
End Property 

Public Property Get ChecksumQ As Boolean 
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Checksum = mblnChecksum 
End Property 

Public Property Let Checksum(ByVal blnNewValue As Boolean) 

mblnChecksum = blnNewValue 
End Property 

Public Property Get PrologStringQ As String 

PrologString = mstrPrologString 
End Property 

Public Property Let PrologString(ByVal strNewValue As String) 

mstrPrologString = strNewValue 
End Property 

Public Property Get VariableTypeQ As VariableType 

VariableType = mudtVariableType 
End Property 

Public Property Let VariableType(ByVal udtNewValue As VariableType) 

mudtVariableType = udtNewValue 
End Property 
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' VarFraction.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l True 
END 

Attribute VB_Name = "VarFraction" 
Attribute VB^GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Implements Variable 

Private mudtVar As Variable 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer = 1 

Private mstrFromNum As String 
Private mstrFromDen As String 
Private mstrToNum As String 
Private mstrToDen As String 
Private mstrByNum As String 
Private mstrByDen As String 
Private mblnMixedNumbers As Boolean 
Private mblnlslndependent As Boolean 

Private Sub Class_Initialize() 

Set mudtVar = New Variable 

End Sub 

Private Sub Class_Terminate() 

Set mudtVar Nothing 
End Sub 

' Delegated to Class Variable 

Public Property Get Variable_Name() As String 

Variable Name = mudtVar.Name 



End Property 



' Delegated to Class Variable 

Public Property Let Variable_Name(ByVal RHS As String) 

mudtVar.Name = RHS 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Typ(ByVal udtNewValue As VariableType) 

mudtVar.Typ udtNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Typ() As VariableType 

Variable^Typ = mudtVar.Typ 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Index() As Long 

Variable_Index = mudtVar.Index 

End Property 

' Delegated to Class Variable 

Public Property Let VariableJndex(ByVal IngNewValue As Long) 

mudtVar.Index = IngNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Enabled() As Boolean 

Variable_Enabled = mudtVar.Enabled 
End Property 

' Delegated to Class Variable 
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Public Property Let Variable__Enabled(ByVal RHS As Boolean) 

mudtVar.Enabled - RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_IsDirty() As Boolean 

Variable_IsDirty = mudtVar.IsDirty 

End Property 

' Delegated to Class Variable 

Public Property Let VariableJsDirty(ByVal RHS As Boolean) 

mudtVar.IsDirty = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Checksum() As Boolean 

Variable_Checksum = mudtVar, Checksum 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Checksum(ByVal blnNewValue As Boolean) 

mudtVar.Checksum = blnNewValue 
End Property 

Public Property Get FromNumeratorQ As String 

FromNumerator = mstrFromNum 
End Property 

Public Property Let FromNumerator(ByVal strNewValue As String) 

mstrFromNum = strNewValue 
mudtVar.IsDirty = True 
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End Property 

Public Property Get FromDenominatorQ As String 

FromDenominator = mstrFromDen 
End Property 

Public Property Let FromDenominator(ByVal strNewValue As String) 

mstrFromDen = strNewValue 
mudtVar.IsDirty = True 

End Property 

Public Property Get ToNumerator() As String 

ToNumerator = mstrToNum 
End Property 

Public Property Let ToNumerator(ByVal strNewValue As String) 

mstrToNum = strNewValue 
mudtVar JsDirty = True 

End Property 

Public Property Get ToDenominator() As String 

ToDenominator = mstrToDen 
End Property 

Public Property Let ToDenominator(ByVal strNewValue As String) 

mstrToDen = strNewValue 
mudtVar.IsDirty = True 

End Property 

Public Property Get ByNumeratorQ As String 
ByNumerator = mstrByNum 
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End Property 

Public Property Let ByNumerator(ByVal strNew Value As String) 

mstrByNum = strNewValue 
mudtVarJsDirty ^ True 

End Property 

Public Property Get ByDenominator() As String 

ByDenominator = mstrByDen 
End Property 

Public Property Let ByDenominator(ByVal strNewValue As String) 

mstrByDen ^ strNewValue 
mudtVar.IsDirty = True 

End Property 

Public Property Get MixedNumbersQ As Boolean 

MixedNumbers = mblnMixedNumbers 
End Property 

Public Property Let MixedNumbers(ByVal blnNewValue As Boolean) 

mblnMixedNumbers = blnNewValue 
mudtVar.IsDirty = True 

End Property 

Public Property Get IsIndependentQ As Boolean 

Islndependent = mblnlslndependent 
End Property 

Public Property Let IsIndependent(ByVal blnNewValue As Boolean) 

mblnlslndependent = blnNewValue 
mudtVar.IsDirty = True 
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End Property 

Public Sub Update(ByVal strName As String, _ 

ByVal strFromN As String, ByVal strFromD As String, 

ByVal strToN As String, ByVal strToD As String, _ 

ByVal strByN As String, ByVal strByD As String, _ 

ByVal blnlslndependent As Boolean, ByVal blnChecksum As Boolean, 

ByVal blnMixedNumber As Boolean) 

Variable_Name ^ strName 
FromNumerator = strFromN 
FromDenominator = strFromD 
ToNumerator = strToN 
ToDenominator = strToD 
ByNumerator = strByN 
ByDenominator ^ strByD 
Islndependent = blnlslndependent 
Variable_Checksum = blnChecksum 
MixedNumbers = blnMixedNumber 

End Sub 



Public Function Variable__PrologFormat() As String 

Dim strl As String 

If mblnlslndependent Then 

strl = "fraction^ & mudtVar.Name & "),offgrid(" & _ 
mudtVar.Name & "),[" & _ 
mstrFromNum & 7" & mstrFromDen & "<=" & 
mudtVar.Name & & mstrToNum & 7" & _ 
mstrToDen & " step " 8c mstrByNum & 7" & mstrByDen & "] 

Else 

strl = "fraction(" & mudtVanName & 
End If 

Variable_PrologFormat = strl 
End Function 

Public Function Variable_ScreenFormat() As String 

Dim strl As String 
Dim strOpt As String 
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If mudtVar.Checksum Then 

strOpt = "(C," 
Else 

strOpt = "(c," 
End If 

If mblnMixedNumbers Then 

StrOpt = StrOpt & "M)," 
Else 

StrOpt == StrOpt & "m)," 
End If 

If mblnlslndependent Then 

strl = mudtVar.Name & strOpt & Fraction, " & _ 
mstrFromNum & 7" & mstrPromDen & " to " & _ 
mstrToNum & 7" & mstrToDen & by " & _ 
mstrByNum & 7" & mstrByDen 

Else 

strl = mudtVar.Name & strOpt & Fraction" 
End If 

Variable_ScreenFormat = strl 
End Function 

Public Property Get Variable_ReadType(udtFile As File) As VariableType 

Variable_ReadType = mudtVar.ReadType(udtFile) 
End Property 

Public Sub Variable_ReadObjectData(udtFile As File) 
Dim vField As Variant 

Call udtFile.ReadField(vField) ' reads version stamp 
Call udtFile.ReadField(vField) 
mudtVar.Name = vField 

Call udtFile.ReadField(vField) 
mudtVar.Enabled = vField 

Call udtFile.ReadField(vField) 
mudtVar.Checksum = vField 
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Call udtFile.ReadField(vField) 
Islndependent = vField 



Call udtFile.ReadField(vField) 
FromNumerator = vField 

Call udtFile.ReadField(vField) 
FromDenominator = vField 

Call udtFile.ReadField(vField) 
ToNumerator = vField 

Call udtFile.ReadField(vField) 
ToDenominator = vField 

Call udtFile.ReadField(vField) 
ByNumerator = vField 

Call udtFile.ReadField(vField) 
ByDenominator = vField 

Call udtFile.ReadField(vField) 
MixedNumbers = vField 

End Sub 

Public Sub Variable_WriteObjectData(udtFile As File) 

Dim udtType As VariableType 

udtType = vtFraction 

Call udtFile.WriteField(udtType) 

CalludtFile.WriteField(mintVERSIONSTAMP) 

CalludtFile.WriteField(mudtVar.Name) 

CalludtFile.WriteField(mudtVar.Enabled) 

Call udtFile.WriteField(inudtVar. Checksum) 

Call udtFile.WriteField(IsIndependent) 

Call udtFile.WriteField(FromNumerator) 

Call udtFile.WriteField(FromDenominator) 

CalludtFile.WriteField(ToNumerator) 

Call udtFile . WriteFi eld(ToDenominator) 

Call udtFile.WriteField(ByNumerator) 

Call udtFile.WriteField(ByDenominator) 

Call udtFile.WriteField(MixedNumbers) 
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mudtVar.IsDirty = False 
End Sub 

' makes a copy of this object 

Public Function Variable_Copy() As Variable 

Dim udtVF As New VarFraction 
Dim udtV As Variable 

Set udtV = udtVF 

udtV.Name = mudtVar.Name 
udtV.Enabled = mudtVar.Index 
udtV.IsDirty ^ mudtVar.IsDirty 
udtV.Checksum = mudtVar. Checksum 

udtVF.FromNumerator = FromNumerator 
udtVF.FromDenominator = FromDenominator 
udtVF.ByNumerator = ByNumerator 
udtVF.ByDenominator = ByDenominator 
udtVF.ToNumerator ~ ToNumerator 
udtVF.ToDenominator = ToDenominator 
udtVF.IsIndependent = Islndependent 
udtVF.MixedNumbers = MixedNumbers 

Set Variable_Copy = udtV 

End Function 
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' Variable. els 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = 0 'False 

Persistable = 0 'NotPersistable 

DataBindingBehavior = 0 VbNone 

DataSourceBehavior = 0 VbNone 

MTSTransactionMode =0 'Not AnMTS Object 
END 

Attribute VB_Name - "Variable" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 

Attribute VB_Ext_KEY = " Saved WithClassBuilder" ,"Yes' 
Attribute VB_Ext_KEY - "Top_Level" /'Yes" 
Option Explicit 

Private mstrName As String 
Private mudtType As VariableType 
Private mlnglndex As Long 
Private mblnEnabled As Boolean 
Private mblnlsDirty As Boolean 
Private mblnChecksum As Boolean 

Public Enum VariableType 

vtlnteger = 0 

vtReal = 1 

vtFraction = 2 

vtString = 3 

vtUntyped = 4 
End Enum 

Public Property Get name() As String 

name = mstrName 
End Property 

Public Property Let name(ByVal strNewValue As String) 

If mstrName <> strNewValue Then 
mstrName = strNev^Value 
mblnlsDirty = True 



VBSCA -428- 



End If 
End Property 

Public Property Get Typ() As VariableType 

Typ = mudtType 
End Property 

Public Property Let Typ(ByVal udtNewValue As VariableType) 

If mudtType <> udtNewValue Then 

mudtType = udtNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get index() As Long 

index = mlnglndex 
End Property 

Public Property Let index(ByVal IngNewValue As Long) 

If mlnglndex <> IngNewValue Then 

mlnglndex = IngNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get EnabledQ As Boolean 

Enabled = mblnEnabled 
End Property 

Public Property Let Enabled(ByVal blnNewValue As Boolean) 

If mblnEnabled <> blnNewValue Then 
mblnEnabled = blnNewValue 
mblnlsDirty = True 
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End If 
End Property 

Public Property Let IsDirty(By Val blnNewValue As Boolean) 

mblnlsDirty = blnNewValue 
End Property 

Public Property Get IsDirtyQ As Boolean 

IsDirty = mblnlsDirty 
End Property 

Public Property Let Checksum(ByVal blnNewValue As Boolean) 

If mblnChecksum <> blnNewValue Then 

mblnChecksum = blnNewValue 

mblnlsDirty - True 
End If 

End Property 

Public Property Get ChecksumQ As Boolean 

Checksum ^ mblnChecksum 
End Property 

' implemented in the subclasses of Variable 
Public Function PrologFormatQ As String 
End Function 

' implemented in the subclasses of Variable 
Public Function ScreenFormat() As String 
End Function 

' implemented in the subclasses of Variable 
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Public Sub ReadObjectData(udtFile As File) 
End Sub 

' implemented in the subclasses of Variable 
Public Sub WriteObjectData(udtFile As File) 
End Sub 

Public Property Get ReadType(udtFile As File) As VariableType 

Dim udtType As VariableType 

Call udtFile.ReadField(udtType) 

ReadType = udtType 
End Property 

' implemented in the subclasses of Variable 
Public Function Copy() As Variable 
End Function 
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' Varlnteger.cls 
VERSION 1.0 CLASS 
BEGIN 

Multiuser -1 True 
END 

Attribute VB_Name = " Varlnteger" 
Attribute VB_GlobalNanieSpace = False 
Attribute VB_Creatable - True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Implements Variable 

Private mudtVar As Variable 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer = 1 

Private mstrFrom As String 

Private mstrTo As String 

Private mstrBy As String 

Private mblnlslndependent As Boolean 

Private Sub Class_Initialize() 

Set mudtVar = New Variable 

End Sub 

Private Sub Class_Terminate() 

Set mudtVar = Nothing 
End Sub 

' Delegated to Class Variable 

Public Property Get Variable_Name() As String 

Variable_Name = mudtVar.Name 

End Property 

' Delegated to Class Variable 



Public Property Let Variable_Name(ByVal RHS As String) 

mudtVar.Name - RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Typ() As VariableType 

Variable_Typ ^ mudtVar.Typ 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Typ(ByVal udtNewValue As VariableType) 

mudtVar.Typ ^ udtNewValue 
End Property 

* Delegated to Class Variable 

Public Property Get Variable_Index() As Long 

Variable_Index = mudtVar index 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_Index(ByVal IngNewValue As Long) 

mudtVar. Index = IngNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Enabled() As Boolean 

Variable_Enabled = mudtVar. Enabled 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_Enabled(ByVal RHS As Boolean) 
mudtVar.Enabled = RHS 
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End Property 

' Delegated to Class Variable 

Public Property Get Variable_IsDirty() As Boolean 

Variable_IsDirty = mudtVar.IsDirty 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_IsDirty(ByVal RHS As Boolean) 

mudtVar JsDirty = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Checksum() As Boolean 

Variable_Checksum = mudtVar. Checksum 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Checksum(ByVal blnNewValue As Boolean) 

mudtVar. Checksum = blnNewValue 
End Property 

Public Property Get From() As String 

From - mstrFrom 
End Property 

Public Property Let From(ByVal strNewValue As String) 

If mstrFrom <> strNewValue Then 

mstrFrom = strNewValue 

mudtVar.IsDirty = True 
End If 

End Property 
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Public Property Get Too() As String 

Too = mstrTo 
End Property 

Public Property Let Too(ByVal strNewValue As String) 

If mstrTo <> strNewValue Then 

mstrTo = strNewValue 

mudtVar.IsDirty = True 
End If 

End Property 

Public Property Get By() As String 

By = mstrBy 
End Property 

Public Property Let By(ByVal strNewValue As String) 

If mstrBy <> strNewValue Then 

mstrBy = strNewValue 

mudtVar.IsDirty = True 
End If 

End Property 

Public Property Get IsIndependentQ As Boolean 

Islndependent = mblnlslndependent 
End Property 

Public Property Let Islndependent (By Val blnNewValue As Boolean) 

If mblnlslndependent <> blnNewValue Then 

mblnlslndependent = blnNewValue 

mudtVar.IsDirty = True 
End If 

End Property 
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Public Sub Update(ByVal strName As String, _ 

ByVal strFrom As String, ByVal strTo As String, ByVal strBy As String, 
ByVal blnlslndependent As Boolean, ByVal blnChecksum As Boolean) 

Variable_Name = strName 
From = strFrom 
Too = strTo 
By = StrBy 

Islndependent = blnlslndependent 
Variable_Checksum = blnChecksum 

End Sub 

Public Function Variable_PrologFormat() As String 

Dim strl As String 

If mblnlslndependent Then 

strl = "int(" & mudtVar.Name & "),[" & mstrFrom & "<=" & _ 
mudtVar.Name & "<=" & mstrTo & " step " & mstrBy & 

Else 

strl = "intC & mudtVar.Name & 
End If 

Variable__PrologFormat = strl 
End Function 

Pubhc Function Variable_ScreenFormat() As String 

Dim strl As String 
Dim strT As String 
Dim strOpt As String 

If mudtVar. Checksum Then 

strOpt = "(C)" 
Else 

StrOpt - "(c)" 
End If 

If mblnlslndependent Then 

strl = mudtVar.Name & strOpt & ": Int, " & mstrFrom & " to " & _ 
mstrTo & " by " & mstrBy 

Else 

strl = mudtVar.Name & strOpt & ": Int" 
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End If 

Variable__ScreenFormat = strl 
End Function 

Public Property Get Variable_ReadType(udtFile As File) As VariableType 

Variable_ReadType = niudtVar.ReadType(udtFile) 
End Property 

Public Sub Variable_ReadObjectData(udtFile As File) 
Dim vField As Variant 

Call udtFile.ReadField(vField) ' reads version stamp 

Call udtFile.ReadField(vField) 
mudtVar.Name = vField 

Call udtFile.ReadField(vField) 
mudtVar. Enabled = vField 

Call udtFile.ReadField(vField) 
mudtVar. Checksum = vField 

Call udtFile.ReadField( vField) 
From = vField 

Call udtFile.ReadField(vField) 
Too = vField 

Call udtFile.ReadField(vField) 
By ^ vField 

Call udtFile.ReadField(vField) 
Islndependent = vField 

End Sub 

Public Sub Variable_WriteObjectData(udtFile As File) 
Dim udtType As VariableType 
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udtType = vtlnteger 

Call udtFile.WriteField(udtType) 

Call udtFile.WriteField(mintVERSIONSTAMP) 

Call udtFile.WriteField(mudtVar.Name) 

Call udtFile.WriteField(mudtVar.Enabled) 

Call udtFile.WriteField(mudtVar. Checksum) 

Call udtFile.WriteField(From) 

Call udtFile.WriteField(Too) 

Call udtFile.WriteField(By) 

Call udtFile.WriteField(IsIndependent) 

mudtVar.IsDirty = False 

End Sub 

' makes a copy of this object 

Public Function Variable_Copy() As Variable 

Dim udtVI As New Varlnteger 
Dim udtV As Variable 

Set udtV - udtVI 

udtV.Name = mudtVar.Name 
udtV.Typ = vtlnteger 
udtV.Enabled = mudtVarJndex 
udtV.IsDirty = mudtVar.IsDirty 
udtV.Checksum = mudtVar. Checksum 

udtVLFrom = From 
udtVLToo = Too 
udtVLBy - By 

udtVLIsIndependent = Islndependent 
Set Variable_Copy = udtV 
End Function 
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' VarReal.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l Trae 
END 

Attribute VB_Name = "VarReal" 
Attribute VB_GlobalNameSpace = False 
Attribute VB^Creatable = True 
Attribute VB__PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Implements Variable 

Private mudtVar As Variable 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer = 2 

Private mstrFrom As String 

Private mstrTo As String 

Private mstrBy As String 

Private mblnTrailingZeros As Boolean 

Private mstrPrecision As String 

Private mblnlslndependent As Boolean 

Private mblnlsOnOrid As Boolean 

Private Sub Class_Initialize() 

Set mudtVar = New Variable 

End Sub 

Private Sub Class_Terminate() 

Set mudtVar = Nothing 
End Sub 

' Delegated to Class Variable 

Pubhc Property Get Variable_Name() As String 

Variable Name = mudtVar.Name 



End Property 

' Delegated to Class Variable 

Public Property Let Variable_Name(ByVaI RHS As String) 

mudtVar.Name = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Typ() As VariableType 

Variable_Typ = mudtVar.Typ 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Typ(ByVal udtNew Value As VariableType) 

mudtVar.Typ = udtNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Enabled() As Boolean 

Variable_Enabled = mudtVar, Enabled 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_Enabled(ByVal RHS As Boolean) 

mudtVar.Enabled RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Index() As Long 

Variable_Index = mudtVar Jndex 

End Property 

' Delegated to Class Variable 
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Public Property Let Variable_Index(ByVal IngNewValue As Long) 

mudtVar. Index = IngNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_IsDirty() As Boolean 

Variable__IsDirty = mudtVar JsDirty 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_IsDirty(ByVal RHS As Boolean) 

mudtVar.IsDirty - RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Checksum() As Boolean 

Variable_Checksum = mudtVar. Checksum 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Checksum(ByVal blnNewValue As Boolean) 

mudtVar. Checksum = blnNewValue 
End Property 

Public Property Get From() As String 

From = mstrFrom 
End Property 

Public Property Let From(ByVal strNewValue As String) 

If mstrFrom <> strNewValue Then 
mstrFrom = strNewValue 
mudtVar.IsDirty = True 
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End If 
End Property 

Public Property Get Too() As String 

Too ^ mstrTo 
End Property 

Public Property Let Too(ByVal strNewValue As String) 

If mstrTo <> strNewValue Then 

mstrTo = strNewValue 

mudtVar .IsDirty = True 
End If 

End Property 

Public Property Get By() As String 

By = mstrBy 
End Property 

Public Property Let By(ByVal strNewValue As String) 

If mstrBy <> strNewValue Then 

mstrBy = strNewValue 

mudtVar JsDirty = True 
End If 

End Property 

Public Property Get TrailingZerosQ As Boolean 

TrailingZeros = mblnTrailingZeros 
End Property 

Public Property Let TrailingZeros(ByVal blnNewValue As Boolean) 

If mblnTrailingZeros <> blnNewValue Then 
mblnTrailingZeros = blnNewValue 
mudtVar JsDirty = True 
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End If 
End Property 

Public Property Get IsOnGridQ As Boolean 

IsOnGrid - mblnlsOnGrid 
End Property 

Public Property Let IsOnGrid(ByVal blnNewValue As Boolean) 

If mblnlsOnGrid <> blnNewValue Then 

mblnlsOnGrid = blnNewValue 

mudtVar.IsDirty = True 
End If 

End Property 

Public Property Get PrecisionQ As String 

Precision = mstrPrecision 
End Property 

Public Property Let Precision(ByVal strNewValue As String) 

If mstrPrecision <> strNewValue Then 

mstrPrecision = strNewValue 

mudtVar.IsDirty = True 
End If 

End Property 

Public Property Get DecimalPlaces() As Integer 

If InStr(l, mstrPrecision, ".") = 0 Then 

DecimalPlaces = 0 
Else 

DecimalPlaces = Len(mstrPrecision) - 1 
End If 

End Property 

Public Property Get IsIndependentQ As Boolean 
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Islndependent = mblnlslndependent 
End Property 

Public Property Let IsIndependent(ByVal blnNewValue As Boolean) 

If mblnlslndependent <> blnNewValue Then 

mblnlslndependent = blnNewValue 

mudtVar.IsDirty = True 
End If 

End Property 

Public Sub Update(ByVal strName As String, _ 

ByVal strFrom As String, ByVal strTo As String, ByVal strBy As String, _ 
ByVal blnlslndependent As Boolean, ByVal blnChecksum As Boolean, _ 
ByVal blnTrailingZeros As Boolean, _ 

ByVal strPrecision As String, ByVal blnlsOnGrid As Boolean) 

Variable_Name = strName 
From = StrFrom 
Too ^ StrTo 
By - StrBy 

Islndependent = blnlslndependent 
Variable_Checksum = blnChecksum 
TrailingZeros = blnTrailingZeros 
Precision = strPrecision 
IsOnGrid - blnlsOnOrid 

End Sub 

Public Function Variable_PrologFormat() As String 

Dim strl As String 

If mblnlslndependent Then 

strl = "real({" & mudtVar.Name & & mstrPrecision & "}),[" _ 

& mstrFrom & & mudtVar.Name & "<=" & mstrTo & " step " & 
mstrBy & 

Else 

strl = "real(" & mudtVar.Name & ")" 
End If 

If Not mblnlsOnOrid Then 

strl - strl & ",offgrid(" & mudtVar.Name & ")" 
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End If 

Variable_PrologFormat = strl 
End Function 

5 Public Function Variable_ScreenFonnat() As String 

Dim strl As String 
Dim strOpt As String 

10 If mudtVar.Checksum Then 

strOpt = "(C," 
Else 

StrOpt = "(c," 
End If 

15 

If mblnTrailingZeros Then 
f . StrOpt = StrOpt & "T," 

J ■■ Else 

ni StrOpt = StrOpt & "t," 

2^1 End If 

4} If mbhilsOnGrid Then 
J" StrOpt = StrOpt & "G," 

Else 

21. StrOpt = StrOpt & "g," 

End If 

' StrOpt = StrOpt & mstrPrecision & ")" 

30=5 If mblnlsIndependentThen 

strl = mudtVar.Name & strOpt & ": Real, " & mstrFrom & " to " & _ 
mstrTo & " by " & mstrBy 

Else 

strl = mudtVar.Name & strOpt & ": Real" 
35 End If 

Variable_ScreenFormat = strl 

End Function 

Public Property Get Variable_ReadType(udtFile As File) As VariableType 
40 Variable_ReadType = mudtVar.ReadType(udtFile) 
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End Property 



Public Sub Variable_ReadObjectData(udtFile As File) 

Dim vField As Variant 
Dim intVersion As Integer 

Call udtFile.ReadField(vField) ' reads version stamp 
intVersion = vField 

Call udtFile.ReadField(vField) 
mudtVar.Name ^ vField 

Call udtFile.ReadField(vField) 
mudtVar.Enabled = vField 

Call udtFile.ReadField(vField) 
mudtVar. Checksum = vField 

Call udtFile.ReadField(vField) 
From = vField 

Call udtFile,ReadField(vField) 
Too = vField 

Call udtFile.ReadField(vField) 
By = vField 

Call udtFile.ReadField(vField) 
TrailingZeros = vField 

Call udtFile.ReadField(vField) 
Precision = vField 

Call udtFile.ReadField(vField) 
Islndependent = vField 

If intVersion < 2 Then ' this field is new to version 2 of VarReal 

IsOnGrid = True 
Else 

Call udtFile.ReadField(vField) 
IsOnGrid - vField 
End If 

End Sub 
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Public Sub Variable_WriteObjectData(udtFile As File) 

Dim udtType As VariableType 

udtType = vtReal 

Call udtFile.WriteField(udtType) 

Call udtFile.WriteField(mintVERSIONSTAMP) 

Call udtFile.WriteField(mudtVar.Name) 

Call udtFile.WriteField(mudtVar.Enabled) 

Call udtFile.WriteField(mudtVar. Checksum) 

Call udtFile.WriteField(From) 

Call udtFile.WriteField(Too) 

Call udtFile,WriteField(By) 

Call udtFile,WriteField(TrailingZeros) 

Call udtFile,WriteField(Precision) 

Call udtFile.WriteField(IsIndependent) 

Call udtFile.WriteField(IsOnGrid) 

mudtVar.IsDirty = False 

End Sub 

' makes a copy of this object 

Public Function Variable_Copy() As Variable 

Dim udtVR As New VarReal 
Dim udtV As Variable 

Set udtV = udtVR 

udtV.Name = mudtVar.Name 
udtV.Typ = VtReal 
udtV. Enabled = mudtVar.Index 
udtV.IsDirty mudtVar.IsDirty 
udtV. Checksum = mudtVar. Checksum 

udtVR.From = From 
udtVR.Too = Too 
udtVR.By = By 
udtVR.Precision = Precision 
udtVR.TrailingZeros = TrailingZeros 
udtVR.IsIndependent = Islndependent 
udtVRJsOnGrid = IsOnGrid 

Set Variable__Copy = udtV 
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End Function 
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' VarString.cls 
VERSION 1.0 CLASS 
BEGIN 
MultiUse--! True 
END 

Attribute VB_Name = "VarString" 
Attribute VB_GIobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Implements Variable 

Private mudtVar As Variable 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer = 1 

Private mstrDelimiter As String 

Private mblnlslndexed As Boolean 

Private mcolString As New Collection 

Private Sub Class_Initialize() 

Set mudtVar = New Variable 

End Sub 

Private Sub Class_Terminate() 

Set mudtVar = Nothing 
End Sub 

' Delegated to Class Variable 

Public Property Get Variable_Name() As String 

Variable_Name = mudtVar.Name 

End Property 



' Delegated to Class Variable 

Public Property Let Variable_Name(ByVal RHS As String) 

mudtVar.Name = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Typ() As VariableType 

Variable_Typ = mudtVar.Typ 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Typ(By Val udtNewValue As VariableType) 

mudtVar.Typ = udtNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Index() As Long 

Variable_Index = mudtVar. Index 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_Index(ByVal IngNewValue As Long) 

mudtVarJndex = IngNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Enabled() As Boolean 

Variable__Enabled = mudtVar.Enabled 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_Enabled(ByVal RHS As Boolean) 
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mudtVar.Enabled = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_IsDirty() As Boolean 

Variable_IsDirty ^ mudtVar.IsDirty 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_IsDirty(ByVal RHS As Boolean) 

mudtVar.IsDirty = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Checksum() As Boolean 

Variable_Checksum = mudtVar. Checksum 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Checksum(ByVal blnNewValue As Boolean) 

mudtVar.Checksum = blnNewValue 
End Property 

Public Property Get DelimiterQ As String 

Delimiter = mstrDelimiter 
End Property 

Public Property Let Delimiter(ByVal strNewValue As String) 

If mstrDelimiter <> strNewValue Then 

mstrDelimiter = strNewValue 

mudtVar.IsDirty = True 
End If 
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End Property 

Public Property Get IsIndexedQ As Boolean 

Islndexed = mblnlslndexed 
End Property 

Public Property Let IsIndexed(ByVal blnNewValue As Boolean) 

mblnlslndexed = blnNewValue 
End Property 

Public Property Get StringCollection() As Collection 

Set StringCollection = mcolString 
End Property 

Public Property Let StringCollection(ByVal colNewValue As Collection) 
Dim intlndex As Integer 

If mcolString.Count <> colNewValue. Count Then 

Set mcolString = colNewValue 

mudtVar.IsDirty = True 

Exit Property 
End If 

For intlndex = 1 To mcolString.Count 

If mcolString Jtem(intlndex) <> colNewValue Jtem(intlndex) Then 
Set mcolString = colNewValue 
mudtVar.IsDirty = True 
Exit Property 
End If 
Next intlndex 

End Property 

' returns the largest number of delimited substrings in the string collection 
Public Property Get Numlndices() As Integer 

Dim into As Integer 
Dim intHiD As Integer 



VBSCA -452- 



Dim intl As Integer 

Dim varS As Variant 

Dim udtSubStr As New Substring 

' if there are no strings in the collection 
If mcolString. Count = 0 Then 

Numlndices = 1 

Exit Property 
End If 

udtSubStr.Delimiter = mstrDelimiter 

For Each varS In mcolString 

udtSubStr.StringValue = varS 

intD = udtSubStr.NumSubStrings 

IfintD>intHiD Then 
intHiD = intD 

End If 
Next varS 

Numlndices = intHiD 
End Property 

Public Function Variable_PrologFormat() As String 

Variable_PrologFormat = 
End Function 

Public Function Variable_ScreenFormat() As String 

Dim strl As String 
Dim strS As String 
Dim intlndex As Integer 
Dim strOpt As String 

If mudtVar. Checksum Then 

strOpt = "(C," 
Else 

StrOpt = "(c," 
End If 

StrOpt = StrOpt & Str(NumIndices) & & mstrDelimiter & 



VBSCA -453- 



For intlndex = 1 To 3 



If mcolString.Count >= intlndex Then 

strS =^ strS & mcolString.Item(intlndex) 

If mcolString.Count > intlndex Then 
StrS - StrS & 

End If 
End If 

Next intlndex 

If mcolString.Count > 3 Then 

StrS = StrS &".,." 
End If 

strl = mudtVar.Name & strOpt & String, in [" & strS & 
Variable_ScreenFormat = strl 
End Function 

Public Property Get Variable_ReadType(udtFile As File) As VariableType 

Variable_ReadType = mudtVar.ReadType(udtFile) 
End Property 

Public Sub Variable_ReadObjectData(udtFile As File) 

Dim vField As Variant 
Dim intCount As Integer 

Call udtFile.ReadField(vField) ' reads version stamp 
Call udtFile.ReadField(vField) 
mudtVar.Name = vField 

Call udtFile.ReadField(vField) 
mudtVar.Enabled = vField 

Call udtFile.ReadField(vField) 
mudtVar. Checksum = vField 

Call udtFile.ReadField(vField) 
mstrDelimiter = vField 
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Call udtFile.ReadField(vField) 
mblnlslndexed = vField 

Call udtFile.ReadField(vField) 
intCount = vField 

Dim inti As Integer 

' read in the strings 
For intI = 1 To intCount 

Call udtFile.ReadField(vField) 
Call mcolString.Add(vField) 

Next intI 

End Sub 

Public Sub Variable_WriteObjectData(udtFile As File) 

Dim udtType As VariableType 

udtType = vtString 

Call udtFile.WriteField(udtType) 

CalludtFile.WriteField(mintVERSIONSTAMP) 

Call udtFile.WriteField(mudtVar.Nanie) 

Call udtFile.WriteField(mudtVar.Enabled) 

CalludtFile.WriteField(mudtVar.Checksum) 

CalludtFile.WriteField(mstrDelimiter) 

CalludtFile.WriteField(mblnlsIndexed) 

Dim intCount As Integer 

intCount = mcolString.Count 
Call udtFile.WriteField(intCount) 

Dim intI As Integer 

' write out the strings 

For intI = 1 To mcolString.Count 

Call udtFile.WriteField(mcolString.Item(intI)) 
Next intI 

mudtVar.IsDirty = False 
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End Sub 



' makes a copy of this object 

Public Function Variable_Copy() As Variable 

Dim udtVS As New VarString 
Dim udtV As Variable 
Dim varS As Variant 

Set udtV = udtVS 

udtV.Name ^ mudtVar.Name 
udtV.Typ = vtString 
udtV.Enabled ^ mudtVar.Index 
udtVJsDirty = mudtVar.IsDirty 
udtV.Checksum = mudtVar. Checksum 

udtVS. Delimiter = Delimiter 
udtVS Jslndexed = Islndexed 

Set Variable_Copy = udtV 

For Each varS In mcolString 

Call udtVS.StringCollection.Add(varS) 
Next varS 



End Function 



' VarUntyped.cls 
VERSION 1.0 CLASS 
BEGIN 

Multiuser -1 True 
END 

Attribute VB_Name - "VarUntyped" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId ^ False 
Attribute VB_Exposed = False 
Option Explicit 



Implements Variable 



Private mudtVar As Variable 



' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer = 1 

Private Sub Class_Initialize() 

Set mudtVar = New Variable 

End Sub 

Private Sub Class_Terminate() 

Set mudtVar = Nothing 
End Sub 

' Delegated to Class Variable 

Public Property Get Variable_Name() As String 

Variable_Name =^ mudtVar.Name 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_Nanie(ByVal RHS As String) 

mudtVar.Name - RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Typ() As VariableType 

Variable_Typ = mudtVar.Typ 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Typ(ByVal udtNewValue As VariableType) 

mudtVar.Typ = udtNewValue 
End Property 
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' Delegated to Class Variable 

Public Property Get Variable_Index() As Long 

Variable_Index = mudtVar.Index 

End Property 

' Delegated to Class Variable 

Public Property Let Variable Jndex(ByVal IngNewValue As Long) 

mudtVar.Index = IngNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Enabled() As Boolean 

Variable_Enabled = mudtVar. Enabled 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_Enabled(ByVal RHS As Boolean) 

mudtVar.Enabled = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_IsDirty() As Boolean 

Variable_IsDirty = mudtVar JsDirty 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_IsDirty(ByVal RHS As Boolean) 

mudtVar JsDirty = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Cliecksum() As Boolean 
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Variable_Checksum = mudtVar. Checksum 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Checksum(ByVal blnNewValue As Boolean) 

mudtVar. Checksum = blnNewValue 
End Property 

Public Function Variable_PrologFormat() As String 

Variable_PrologFormat ^ 
End Function 

Pubhc Function Variable_ScreenFormat() As String 

Dim strl As String 
Dim strS As String 
Dim intlndex As Integer 
Dim strOpt As String 

If mudtVar. Checksum Then 

strOpt = "(C)" 
Else 

StrOpt = "(c)" 
End If 

Strl = mudtVar.Name & strOpt & ": Untyped" 
Variable_ScreenFormat = strl 
End Function 

Pubhc Property Get Variable_ReadType(udtFile As File) As VariableType 

Variable_ReadType = mudtVar.ReadType(udtFile) 
End Property 

Pubhc Sub Variable_ReadObjectData(udtFile As File) 
Dim vField As Variant 
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Dim intCount As Integer 

Call udtFile.ReadField(vField) ' reads version stamp 
Call udtFile.ReadField(vField) 
mudtVar.Name vField 

Call udtFile.ReadField(vField) 
mudtVar.Enabled = vField 

Call udtFile.ReadField(vField) 
mudtVar. Checksum = vField 

End Sub 

Public Sub Variable_WriteObjectData(udtFile As File) 

Dim udtType As VariableType 

udtType = vtUntyped 

Call udtFile.WriteField(udtType) 

Call udtFile.WriteField(mintVERSIONSTAMP) 

Call udtFile.WriteField(mudtVar.Name) 

Call udtFile.WriteField(mudtVar.Enabled) 

Call udtFile,WriteField(mudtVar,Checksum) 

mudtVar.IsDirty = False 

End Sub 

' makes a copy of this object 

Public Function Variable_Copy() As Variable 

Dim udtV As New Variable 

udtV.Name = mudtVar.Name 
udtV.Typ - VtUntyped 
udtV.Enabled = mudtVar.Index 
udtV.IsDirty mudtVar.IsDirty 
udtV, Checksum = mudtVar, Checksum 

Set Variable_Copy = udtV 

End Function 
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' Win32APLcls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse--! True 
END 

Attribute VB_Name = "Win32APr' 
Attribute VB__GlobalNameSpace = False 
Attribute VB__Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
' used for making calls to the Win32 API 
Option Explicit 

Private Type FILETIME 

dwLowDateTime As Long 

dwHighDateTime As Long 
End Type 

Private Const MAX_PATH = 260 

Private Type WIN32_FIND_DATA 

dwFileAttributes As Long 

ftCreationTime As FILETIME 

ftLastAccessTime As FILETIME 

ftLastWriteTime As FILETIME 

nFileSizeHigh As Long 

nFileSizeLow As Long 

dwReservedO As Long 

dwReservedl As Long 

cFileName As String * MAX__PATH 

cAltemate As String * 14 
End Type 

Private Const INVALID_HANDLE_VALUE = -1 

Private Declare Function FindFirstFile Lib "kemel32" Alias "FindFirstFileA" _ 
(ByVal IpFileName As String, IpFindFileData As WIN32_FIND_DATA) As Long 

Private Declare Function FindNextFile Lib "kemel32" Alias "FindNextFileA" _ 
(ByVal hFileName As Long, IpFindFileData As WIN32_FIND_DATA) As Long 

Private Declare Function FindClose Lib "kemel32" (ByVal hFindFile As Long) As Long 

Private Declare Function GetCurrentDirectory Lib "kemel32" _ 
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Alias "GetCurrentDirectoryA" (ByVal nBufferLength As Long, _ 
ByVal IpBuffer As String) As Long 

Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _ 
(ByVal hwnd As Long, _ 
ByVal Msg As Long, _ 
ByVal wParam As Long, _ 
ByVal IParam As Long) As Long 

Private Declare Function SystemParametersInfo Lib "user32" _ 
Alias "SystemParametersInfoA" (ByVal uAction As Long, _ 
ByVal uParam As Long, ByRef IpvParam As Any, _ 
ByVal fuWinIni As Long) As Long 

Private Const SPI_GETDRAGFULLWINDOWS = 38 
Private Const SPI_SETDRAGFULLWINDOWS = 37 
Private Const SPIF_SENDWININICHANGE = 2 

Public Function IsFullWindowDragOn() As Boolean 

Dim result As Long 

'Call API and check for successful call. 

If SystemParametersInfo(SPLGETDRAGFULLWINDOWS, 0&, result, 0&) <> 0 Then 
'Feature supported now check value of result. 
If result = 0 Then 

IsFullWindowDragOn = False 
Else 

IsFullWindowDragOn = True 
End If 

'Call failed, feature not supported. 
Else 

IsFullWindowDragOn = False 
End If 

End Function 

Public Sub TumOffFuUWindowDragO 
Dim result As Long 

resuh = SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 0&, _ 
ByVal vbNullString, SPIF_SENDWININICHANGE) 

End Sub 
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Public Sub TumOnFullWindowDragO 
Dim result As Long 

result - SystemParametersInfo(SPI_SETDRAGFULL WINDOWS, 1&, 
ByVal vbNullString, SPIF_SENDWININICHANGE) 

End Sub 

* returns true if strFN exists 

Public Function FileExists(ByVal strFN) As Boolean 

Dim IngHandle As Long 

Dim w32FindData As WIN32_FIND_DATA 

IngHandle = FindFirstFile(strFN, w32FindData) 

If IngHandle = INVALID_HANDLE_VALUE Then 

FileExists ^ False 
Else 

FileExists = True 
Call FindClose(lngHandle) 
End If 

End Function 

' returns a collection of file names that satisfy strMask. The path seems to 
' disappear from the returned file names. 

Public Function FindAllFiles(ByVal strMask As String) As Collection 

Dim IngHandle As Long 
Dim IngRet As Long 

Dim w32FindData As WIN32_FIND_DATA 

Dim strFN As String 

Dim varl As Variant 

Dim colFNs As New Collection 

IngHandle = FindFirstFile(strMask, w32FindData) 

If IngHandle = INVALID_HANDLE_VALUE Then 

Exit Function 
End If 

Do 
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strFN = TrimAtFirstNull(w32FindData.cFileName) 
Call colFNs. Add(strFN) ' add to the collection 

Loop Until FindNextFile(lngHandle, w32FindData) = 0 

Set FindAUFiles - colFNs 

End Function 

' returns the current directory 

Public Function CurrentDirectoryQ As String 

Dim strBuf As String 
Dim IngRet As Long 
Dim varl As Variant 

StrBuf =Space(3 00) 

IngRet = GetCurrentDirectory(300, strBuf) 
CurrentDirectory = TrimAtFirstNull(strBuf) 

End Function 

' enable full row select in list view control 

Public Sub EnableListViewFullRowSelect(lvwLV As ListView) 

Dim IngStyle As Long 
Dim IngL As Long 

'get the current ListView style 

IngStyle = SendMessageLong(lvwLV.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 
0&) 

'set the extended style bit 

IngStyle - IngStyle Or LVS_EX_FULLROWSELECT 
'set the new ListView style 

IngL - SendMessageLong(lvwLV.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, 
IngStyle) 

End Sub 
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' Word.cls 

VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l True 
END 

Attribute VB_Name = "MSWord" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Private Const WM_CLOSE = &H10 
Private mWDApp As Word.Application 

Private Type RECT 

left As Long 

top As Long 

right As Long 

bottom As Long 
End Type 

Private Declare Function GetParent Lib "user32" _ 
(ByVal hWndChild As Long) As Long 

Private Declare Function SetParent Lib "user32" _ 
(ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long 

Private Declare Function Find Window Lib "user32" _ 
Alias "FindWindowA" (ByVal IpClassName As String, _ 
ByVal IpWindowName As String) As Long 

Private Declare Function SendMessage Lib "user32" _ 
Alias "SendMessageA" _ 

(ByVal hwnd As Long, ByVal wMsg As Long, _ 
ByVal wParam As Long, IParam As Any) As Long 

Private Declare Function GetWindowRect Lib "user32" _ 
(ByVal hwnd As Long, IpRect As RECT) As Long 

Private Declare Function SetWindowPos Lib "user32" _ 
(ByVal hwnd As Long, ByVal hWndlnsertAfter As Long, _ 
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _ 
ByVal cy As Long, ByVal wFlags As Long) As Long 
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Dim mlngHandle As Long 
Dim origParent As Long 
Dim origLeft As Long 
Dim origTop As Long 
Dim origWidth As Long 
Dim origHeight As Long 

Private Sub Class_Initialize() 

' mlngHandle = FindWindow("OpusApp", vbNuUString) 

' Do While mlngHandle <> 0 

SendMessage mlngHandle, WM_CLOSE, mlngHandle, 0 
' mlngHandle = FindWindow("OpusApp", vbNullString) 
' Loop 

mlngHandle = Find Window(" Opus App", vbNuUString) 

If mlngHandle <> 0 Then 

Set mWDApp = GetObject(, "Word.Apphcation.S") 
Else 

On Error Resume Next 

Set mWDApp = GetObjectG "Word.Application,8") 

If err.Number = 0 Then 

MsgBox "Phantom WinWord detected!" 

Call mWDApp.Quit(False) 
Else 

err. Clear 
End If 

Set mWDApp = CreateObject("Word.Apphcation.8") 
End If 

mlngHandle = Find Window(" Opus App", vbNuUString) 

If mlngHandle <> 0 Then 

origParent ^ GetParent(mlngHandle) 

If mWDApp.left < 0 Then 

origLeft = 0 
Else 

origLeft = mWDApp.left 
End If 
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If mWDApp.top < 0 Then 

origTop = 0 
Else 

origTop = mWDApp.top 
End If 

origWidth - mWDApp. Width 
origHeight ^ mWDApp. Height 

Call SetParent(mlngHandle, fhnTCA.fraWord.hwnd) 
End If 

mWDApp.Visible ^ True 
End Sub 

Private Sub Class_Temiinate() 

mWDApp. Visible = False 

Call SetParent(mlngHandle, origParent) 
Call mWDApp.Move(origLeft, origTop) 
Call mWDApp.Resize(origWidth, origHeight) 

Call mWDApp.Quit(False) ' don't save! 

End Sub 

Public Property Get WordAppO As Word.Application 

Set WordApp = mWDApp 
End Property 

Public Property Get DocumentsCountQ As Long 

DocumentsCount = mWDApp.Documents. Count 
End Property 

Public Property Get SelectionTypeQ As Long 
SelectionType = mWDApp, Selection.Type 
End Property 
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Public Property Get SelectionTextQ As String 

SelectionText = m WD App. Selection. Text 
End Property 
Public Sub ResizeO 

Dim WindowRect As RECT 

GetWindowRect frmTCA.fraWord.hwnd, WindowRect 

Dim IngH As Long 
Dim IngW As Long 

IngW - frmTCA.ScaleX(WindowRect.right - WindowRect.left, vbPixels, vbPoints) 
IngH = frmTCA.ScaleY(WindowRect.bottom - WindowRect.top, vbPixels, vbPoints) 

Call mWDApp.Resize(lngW, IngH) 
Call mWDApp.Move(0, 0) 

' SetWindowPos mlngHandle, 0, 0, 0, _ 
' WindowRect. right - WindowRect. left, _ 
' WindowRect.bottom - WindowRect.top, 64 

CommandBars("File").Controls("Exit").Enabled = False 

End Sub 

Public Sub CloseAllDocsO 

Dim docD As Document 

For Each docD In mWDApp.Documents 

If Not docD.ReadOnly Then 

docD. Close 
Else 

Call docD.Close(False) 
End If 
Next docD 

End Sub 
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' HLP41ib.p4 

%% 

%% HLP41ib.p4: library of ProloglV accessory relations useful in High-Level API 

%% 

%% We follow the convention that the [conventional] result is bound to the first argument, 
%% so that these relations can be easily called as functions. 

%% 

%% Note: BEWARE: Interval operators (e.g. ./., ...) sometimes give rise to errors (e.g. 
divide-by-zero error) 

%% in VB when used in conjunction with VB. 

%% Note: BEWARE: intsplit/realspht on unbounded variabes sometimes give rise to errors 
(e.g. overflow error) 

%% in VB when used in conjunction with VB. 

%% HLAPI-library functions/relations 

%% debug_print(-Resuh, +List): ResuU is true if it prints all the elements of 
the hst, ended by nl 
debug_print(true, []) :- nl. 
debug_print(Resuh, [A| Rest]) :- 

write(A), write(V), 

debug_print(ResuU, Rest). 

%% var_with_precision(+V, +Prec): Succeeds if var V is an integer multiple of 
given Precision. 

%% (Do NOT introduce intsplit(N) here - gives rise to overflow error in VB.) 
var_with_precision(V, Prec) :- 
int(N), 
V - N*Prec. 

%% even(-Result, +N): Result is true if N is an even integer. 
even(true, N) :- 
even(N). 

%% odd(-Result, +N): Resuh is true if N is an odd integer. 
odd(true, N) :- 
odd(N). 

%% max(-ResuU, +A, +B): Result is maximum of A and B, -- already provided in 

ProloglV 

%% max(-Resuh, [A, B, C, ...]): Result is maximum of array of numbers [A, B, C, 

...]. 

max(Result, [A| Rest]) :- 

max_array_aux (Result, A, Rest). 
max__array_aux(A, A, []). 
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max_array_aux(Result, A, [BjRest]) :- 
max(Rmax, A, B), 

max_array_aux (Result, Rmax, Rest). 

%% min(-Result, +A, +B): Result is minimum of A and B. - already provided in 

ProloglV 

%% min(-Result, [A, B, C, ,..]): Result is minimum of array of numbers [A, B, C, 

...]. 

min(Result, [A| Rest]) :- 

min_array_aux(Result, A, Rest), 
min_array_aux(A, A, []). 
min_array_aux(Result, A, [B|Rest]) :- 

min(Rmin, A, B), 

min_array_aux(Result, Rmin, Rest). 

%% mean(-Mean, A, B): Mean is mean of numbers A & B 
mean((A+B)/2, A, B). 

%% mean(-Mean, [A, B, C, ,..]): Mean is mean of array of numbers [A,B,C,...] 

mean(A, [A]), 

mean(Sum/Size, [A|Rest]) :- 

array_sum(Sum, [A|Rest]), 
size(Size, [A|Rest]). 

%% median(-Med, +[A, B, C, ...]): Med is the median of array of numbers [A, B, 

Q ...] 

median(Med, [A|Rest]) :- 

sort(SortedList, [A|Rest]), 

size(Size, SortedList), 

pick_midlist(Med, SortedList, Size). 
pick_midlist(Mid, List, ListSize) :- 

odd(ListSize), 

index(Mid, List, ((ListSize- 1)/2)+ 1). 
pick__midlist((Midl+Mid2)/2, List, ListSize) > 
even(ListSize), 
index(Midl, List, ListSize/2), 
index(Mid2, List, (ListSize/2)+l). 

%% gcd(-GCD, +A, +B): GCD is gcd of A and B. -- until ProloglV provides 

it. 

gcdtemp(A./.Num, A, B) :- 

int(A), int(B), B gtlin 0, 
numden(A./.B, Num, _Den). 

%% lcm(-LCM, +A, +B): LCM is 1cm of A and B. (lcm(A, B)= A* B/ 
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gcd(A,B) )~ until ProloglV provides it. 
lcmtemp((A *.B)./.GCD, A, B) :- 

int(A), int(B), B gtlin 0, 

gcdtemp(GCD, A, B). 

%% mod(-Mod, N, D): Mod= N modulo M. 
modtemp(Mod, N, D) :- 
int(N), int(D), D gtlin 0, 
modulo(N, D, Mod). 

%% divmod(-DivMod, N, D): True if DivMod= [N Div D, N Mod D] 
divmod([Div, Mod], N, D) :- 

int(N), int(D), D gtlin 0, 
intdiv(Div, N, D), 
modulo(N, D, Mod). 

%% numdentemp([-N, -D], R): True if N/D = R (where N and D are integers) 
numdentemp([N, D], R) :- 
real(R), 

numden(R, N, D). 

%% quotnumden([-Q, -N, -D], R): True if (Q+(N/D)) = R (where Q, N and D are 

integers) 

quotnumden([Q, N, D], R) :- 
real(R), 

numden(R, Nl, D), 
divmod([Q, N],N1,D). 

%% sqrt(Sqrt, N): Sqrt is square-root of N - already provided by ProloglV 
%% isjperfect_square(-Result, +N): succeeds (and sets Result to true) if N is a 

perfect square. 

isj3erfect_square(true, N) :- 
int(N), int(Sqrt), 
sqrt(Sqrt, N). 

%% isnot_perfect_square(-Result, +N): succeeds (and sets Result to true) if N is 
NOT a perfect square. 
isnot_perfect_square(true, N) :- 

int(N), nint(Sqrt), 

sqrt(Sqrt, N). 

%% cubert(-CubeRoot, +N): CubeRoot is cube-root of N 
cubert(CubeRt, N) :- 
int(N), 

root(CubeRt, N, 3). 

%% is__perfect_cube(-Result, +N): succeeds (and sets Result to true) if N is a 
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perfect cube. 

is__perfect__cube(true, N) :- 
mt(N), mt(Cbrt), 
cubert(Cbrt, N). 

%% isnot_j)erfect_cube(-Result, +N): succeeds (and sets Result to true) if N is 
NOT a perfect cube. 
isnot__perfect_cube(true, N) :- 

is_perfect__cube(true5 N), !, fail. 
isnot_perfect_cube(true, N) :- %% this alone does not work well because of roundoff 
problems 

int(N), nint(Cbrt), 
cubert(Cbrt, N). 

%% is_prime(-Result, +N): succeeds (and sets Result to true) if N is a 

prime-number. 

is_prime(true, 2). is_prime(true, 3). %% base cases (note that 1 is NOT considered prime.) 
is_prime(true, N) :- 

int(N), abs(AbsN, N), AbsN gt 3, 

sqrt(RlSqRoot, AbsN), 

ceil(SqRoot, RlSqRoot), 

aux_check_prime(AbsN, 2, SqRoot). 
aux_checkjrime(N, CurDivisor, MaxDivisor) 

CurDivisor gt MaxDivisor. 
aux_check_prime(N, CurDivisor, MaxDivisor) %% improve it later 

CurDivisor le MaxDivisor, 

modulo(N, CurDivisor, Mod), Mod gt 0, 

aux_check_prime(N, CurDivisor + 1, MaxDivisor). 

%% isnot_prime(-Result, +N): succeeds (and sets Result to true) if N is NOT a 

prime-number, 

isnotj)rime(true, N) :- 

nint(N), real(N). 
isnot_prime(true, N) :- 

int(N), abs(AbsN, N), AbsN gt 3, 

sqrt(RlSqRoot, AbsN), 

ceil(SqRoot, RlSqRoot), 

aux_check_nonprime(AbsN, 2, SqRoot), 
aux__check_nonprime(N, CurDivisor, MaxDivisor) :- 

CurDivisor le MaxDivisor, 

modulo(N, CurDivisor, 0), !. 
aux_check_nonprime(N, CurDivisor, MaxDivisor) :- 

CurDivisor le MaxDivisor, 

aux_check_nonprime(N, CurDivisor + 1, MaxDivisor). 
%% nth(-NthElem, +N, +List): NthElem is the Nth element of the given List; 
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(N==l for first elem.) 
nth(NthElem, N, List) :- 
index(NthElem, List, N). 



%% permute(-PennutedList, +List): PermutedList is a permutation of List. 
permute(PermutedList, List) :- 

permute_aux(PermutedList, [], List). 

permute_aux(PermutedList, PermutedList, []). 

permute_aux(PermutedList, APermutation, RightList) :- 
an_elem_and_rest(Elem, Rest, RightList), 
permute_aux(PermutedList, [Elem| APermutation], Rest). 

%% factorial(-Factorial, +N): Factorial= N! 

%% naive implementation: factorial(l, 0). factorial(N* Fact, N) :- 
factorial(Fact, N-1). 

%% we just list them here which also gives a bidirectional relationship. 
factorial(l, 0). factorial(l, 1). factorial(2, 2). 
factorial(6, 3). factorial(24, 4). factorial(120, 5). 
factorial(720, 6). factorial(5040, 7). factorial(40320, 8). 
factorial(362880, 9). factorial(3628800, 10). 

factorial(399 16800, 11). factorial(479001600, 12). 
factorial(6227020800, 13). factorial(871 7829 1200, 14). 
factorial^ 307674368000, 15). factorial(20922789888000, 16). 
factorial(355687428096000, 17). factorial(6402373705728000, 18). 
factorial(121 645 100408832000, 19). factorial(2432902008 176640000, 20). 
factorial(N* Fact, N) :- number(N), N gt 20, factorial(Fact, N-1). 

%% non-naive implementation of factorial - not used 
%% factorial(l, 0). 

%% factorial(Factorial, N) :- 
%% int(N), N gt 0, 

%% factorial(Factorial, N, N.-. 1 ). 

%%factorial(Factorial, Factorial, 0). 
%%factorial(Factorial, FactSoFar, N) :- 
%% N gt 0, 

%% factorial(Factorial, FactSoFar. *.N, N.-. 1). 

%% enumerate(-R, +Min, +Max, +Step): enumerate (any var) R between 
(closed-interval) [Min, Max] by Step. 
enumerate(R, Min, Max, Step) :- 

min(RMin, Min, Max), 

max(RMax, Min, Max), 

RMin le RMax, 
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Step gt 0, 

enumerate_aux(R, RMin, RMax, Step). 

%% enumerate Jnt(-I, +Min, +Max, +Step): enumerate (integer var) I between 
(closed-interval) [Min, Max] by Step. 
enumerate_int(I, Min, Max, Step) :- 
mt(I), 

min(RMin, Min, Max), 
max(RMax, Min, Max), 
RMin le RMax, 
ceil(IMin, RMin), 
floor(IMax, RMax), 
IMin le IMax, 

floor(IStep, Step), %% should IStep be floor, or ceiling ?? 
IStep gt 0, 

enumerate_aux(I, IMin, IMax, IStep). 

%% enumerate_aux(-R, +Min, +Max, +Step): enumerate (any var) R between 
(closed-interval) [Min, Max] by Step. 

%% Note that we enumerate from both ends i.e. from Min and from Max ends. 
%% Note that increasing the no. of partitions requires large choice-stack and heap 

sizes, 

%% (We can adjust the various stack 8l heap sizes - but just that there is a cost to more 
partitions.) 

enumerate_aux(R, Min, Max, Step) :- 

StepsCnt- (Max- Min)/Step, 

StepsCnt le 4, %% le 4 partitions => le 5 points in the range 

!, %% small range - simple enumeration 

enumerate_aux_simple(R, Min, Min, Max, Step). 
enumerate_aux(R, Min, Max, Step) :- %% large range - interleave the enumeration 
StepsCnt- (Max- Min)/Step, %% adjust the Max 
floor(NMax, StepsCnt), 

PartitionStepCnt =^ StepsCnt/6, %% split the steps-range into 5 partitions 
floor(Inc, PartitionStepCnt), %% problem with ceil/2 when numbers are 

small 

enumerate_aux_interleave(R, %% interleave the 10 partitions 

[[Min, Min+ Inc* Step, inc], %% 1st: enumerate up 

[Min+(Inc+l)*Step, Min+2*Inc*Step, dec],%% 2nd: enumerate down 

[Min+(2*Inc+l)*Step,Min+3*Inc*Step,inc], 

[Min+(3*Inc+l)*Step,Min+4*Inc*Step,dec], 

[Min+(4*Inc+l)*Step,Min+NMax*Step,dec]], 
Step). 

%% enumerate R simply between Min & Max by Step 
enumerate_aux_simple(R, R, _Min, _Max, _Step). 
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enumerate_aux_simple(R, Prev, Min, Max, Step) 
(Prev+ Step) le Max, 

enumerate_aux_simple(R, Prev+Step, Min, Max, Step). 

%% enumerate in an interleaved fashion - from all partitions - upward or 

downward 

enumerate_aux_interleave(RMin, [[RMin, RMax, inc]| _Rest], _Step):- 
RMin le RMax. 

enumerate_aux_interleave(RMax, [[RMin, RMax, dec]| _Rest], _Step):- 
RMin le RMax. 

enumerate_aux_interleave(R, [[RMin, RMax, _IncOrDec]| Rest], Step):- 

(RMin+ Step) gt RMax, !, %% partition done - drop it from the partitions-list 
random_shuffle(Shuffled, Rest), 
enumerate_aux_interleave(R, Shuffled, Step). 

enumerate_auxJnterleave(R, [[RMin, RMax, inc]| Rest], Step):- 

random_shuffle(Shuffled, Rest), 

ncons(ResLst, [RMin+ Step, RMax, inc], Shuffled), 

enumerate_aux_interleave(R, ResLst, Step). 
enumerate_aux_interleave(R, [[RMin, RMax, dec]| Rest], Step):- 

random_shuffle(Shuffled, Rest), 

ncons(ResLst, [RMin, RMax- Step, dec], Shuffled), 

enumerate_aux__interleave(R, ResLst, Step). 



%% select_r_of_n_ordered(-Pn_r, +N, +R): Select no. of permutations of setsize 
N selecting R at a time 

select_r_of_n_ordered(Nfact./. Rfact, N, R) :- 

int(N), int(R), N gt 0, R gt 0, N ge R, 
factorial(Nfact, N), 
factoriaI(Rfact, R). 

%% select_r_of_n(-Pn_r, +N, +R): Select no, of combinations of setsize N 
selecting R at a time 
select_r_of_n(Perm./. NRfact, N, R) :- 

select_r_of_n_ordered(Pemi, N, R), 

factorial(NRfact, N-R). 

%% abs(-AbsN, +N): AbsN is absolute number, N. - already provided by 

ProloglV 



%% isbound(-Result, +X): Resuh is true if the given (numerical variable/value) X 
is bound on the low and/or upper side. 
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isbound(true, X) :- isbound(X). 
isbound(X) :-glb(X,J, !. 
isbound(X) lub(X, J. 

%% isnotbound(-Result, +X): Result is true if the given (numerical variable) X 
NOT bound on either the low or the upper side. 
isnotbound(true, X) :- isnotbound(X), 
isnotbound(X) :- isbound(X), !, fail. 
isnotbound(X). 

%% auxiliary functions 

%% even(N): true if N is even 
even(2.*.X) :- int(X). 

%%odd(N): true ifN is odd 
odd(N) int(N), N= 2.^ .X, nint(X). 

%% reverse(-ReverseList, +List): ReverseList is reverse-ordered List 
reverse(ReverseList, List) :- 

reverse(ReverseList, [], List). 
reverse(ReverseList, ReverseList, []). 
reverse(ReverseList, RevListSoFar, [A|Rest]) :- 

reverse(ReverseList, [A|RevListSoFar], Rest). 

%% ncons(-ResList, +A, +List): true if ResList= List+ [A]. 
ncons(ResList, A, List) :- 

append(ResList, List, [A]). 

%% append(-AppendedList, Listl, List2): AppendedList is result of appending 
lists Listl & List2. 
append(A, [], A). 

append([A|Result], [A|Rest], B) :- 
append(Result, Rest, B). 

%% random_shuffle(-ShuffledList, +List): Succeeds if List is random-shuffled 
into SuffledList 

random_shuffle(ShuffledList, List) :- 

random_shuffle(ShuffledList, [], List). 

random_shuffle(ShuffledList, ShuffledList, []). 
random_shuffle(ShuffledList, ShuffledListSoFar, [A| Rest]) :- 

brandom(Random), 

((Random=l) -> 

random_shuffle(ShuffledList, [A|ShuffledListSoFar], Rest); 
(ncons(NewShuffledListSoFar, A, ShuffledListSoFar), 
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random_shuffle(ShuffledList, NewShuffledListSoFar, Rest) ) 



%% array_sum(-ArraySum, +Array): Sum is the sum of the array-elements of 

Array 

array_sum(0, []). 

array_sum(ArraySum, [A|Rest]) :- 
number(A), 

array_sum( Array Sum, A, Rest). 
array_sum(ArraySum, ArraySum, []). 
array_sum(ArraySum, SumSoFar, [A|Rest]) :- 

number(A), 

array_sum(ArraySum, SumSoFar.+.A, Rest). 

%% sort(-SortedArray, +Array): Array (of numbers) is sorted (in ascending order) 
into Sorted Array 
sort([], []). 

sort(SortedArray, [E|Array]) :- %% quicksort 

partition_mine(Smaller, Greater, E, Array), 
sort(SortedSmaller, Smaller), 
sort(SortedGreater, Greater), 

append(SortedArray, SortedSmaller, [E|SortedGreater]). 

%% partition(-Smaller, -Greater, +Elem, +Array): Partition the Array (of 

numbers) into 

%% subarrys Smaller and Greater than Elem. 
partition_mine([], [], []). 

partition_mine([Small|Smaller], Greater, Elem, [Small|Array]) 

Small le Elem, %% Small<= Elem, 

partition_mine(Smaller, Greater, Elem, Array). 
partition_mine(Smaller, [Great] Greater], Elem, [Great|Array]) :- 

Great gt Elem, %% Great > Elem 

partition_mine(Smaller, Greater, Elem, Array). 

%% rotate(-RotatedList, -fList, 4-N): Rotate the given List by N steps into 

RotatedList. 
rotate([], [], J. 

rotate(RotatedList, List, N) :- 

first_N_elems(FirstNElems, RestElems, List, N), 
append(RotatedList, RestElems, FirstNElems). 

%% first_N_elems(-FirstNElems, -RestElems, +List, +N): true if List = 
FirstNElems + RestElems, 
first_N_elems([], List, List, 0). 
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first_N_elems([], [], [],_N). 

first_N_elems([A| NextElems], RestElems, [A| Rest], N) :- 
mt(N),Ngt 0, 

first_N_elems(NextElems, RestElems, Rest, N.-.l). 

%% one_of(Elem, List): true if Elem is an element of the given List 

%%one_of(Elem, List) %% this implementation has some disadvantages 

%% inlist(Elem, List), 

one_of(Elem, [Elemj _]), 
one_of(Elem, [_|List]) :- 
10 one_of(Elem, List). 

%% not_one_of(Elem, List): true if Elem is not an element of the given List 
not_one_of(Elem, List) :- 
outlist(Elem, List). 

15 %% an_elem_and_rest(Elem, Rest, List): true if Elem is an element of the List, 

:r-^ and Rest= List- Elem. 
J] an_elem__and_rest(Elem, Rest, List) :- 
qi an_elem_and_rest_aux(Elem, Rest, [], List). 

Ul an_elem_and_rest_aux(A, Rest, LeftList, [A| Remainder]) :- 

append(Rest, LeftList, Remainder). 
43 ar^elem_and_rest_aux(Elem, Rest, LeftList, [A| Remainder]) :- 
4^^ append(NewLeftList, LeftList, [A]), 

an_elem_and_rest_aux(Elem, Rest, NewLeftList, Remainder). 

2ij 

2f %% random(-Elem, +List): return a random element (Elem) from the given hst 

£'I random(Elem, List) :- 
n list(List), 

R random_shuffle(ShuffledList, List), 

30 one_of(Elem, ShuffledList). 

%% random(-Random, +Range): return a random number in the range 0 ... Range 
random(Rand, Range) :- 

int(Range), Range> 0, 
random(R), 

3 5 modulo(R, Range+ 1 , Rand). 

%% brandom(-BRandom): True if BRandom is a binary (i.e. 0 or 1) random number 
brandom(BRand) : - 

random(Rand), 

(((Rand/2147483647)>= 0.5) -> BRand = 1; BRand = 0). 



40 
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%% random(-Random): True if Random is a (pseudo-) random integer 

%% 

%% Note that this works because ProloglV can handle numbers greater than 32-bits 
randomize(S) :- integer(S), record(seed, S). 
random(X) :- 

recorded(seed, S), 

(integer(S) -> SI = S; Sl= 1), 

Z- 81*16807, 

modulo(Z, 2147483647, X), 

record(seed, X). 

%% KNJ: Seems like a very inadequate randomizer: we get numbers 7n+4 from it ! ! 
%% As such, you will have (for this randomizer): random()% 7= 4. 

%% — Not used any more : KNJ — 

%% KNJ: Modified the multiplier to a prime-no, and that seems to have improved the 
generator. 

%%%%%%%%% 

% Random number generator from Pascal Bouvier of PrologIA : 
%~ random.p4 - 

% un generateur de nombres pseudo-aleatoires. 
% A pseudo-random number generator. 
% (formula got from C-ANSI randomQ ?) 

% 

% Pascal Bouvier, d'apres Prolog III 
%(c) PrologIA 1996,1997 

% initializer 

orandomize(S) :- integer(S) record(oseed, S). 
orandomize(S) :- var(S), record(oseed, 1). 
orandom(X) :- 

recorded(oseed,S), 

(integer(S) -> SI = S ; SI = 1), 

Z = 81*1103515245 + 12345, 

modulo(Z, 65536*65536-1, Zl), 

record(oseed,Zl), 

moduIo(Z,32767, X). 



0/ 0/ 0/ 0/ 0/0/0/0/0/ 

/o /o /o /o /o /o /o /o /o 
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' PrlgExpr.l 

/* 

* PrlgExpr.l: Lexical analyzer for constraints: 

* (splits constraints into lexical-components e.g. words, punctuations). 



#include <math.h> 
#include <malloc.h> 
#include <string.h> 
#include "p4term.h" 
#include "prlgHLAPI.h" 
#include "PrlgExpr.tab.h" 

extern int GetInString(char *buf, int max size); 

//extern int yylval; - supplanted by "extern YYSTYPE yylval;" in PrlgExpr.tab.h 

#define YY_INPUT(buf, result_cnt, max_size) {if ( ! (result_cnt= GetInString(buf, 
max_size))) {bufi:0]= YY_NULL; result_cnt= 1;} } 

#define MAX_VAL_BUF 64 
static charvalBufI64][MAX_VAL_BUF]; 
static int valBuf_x= 0; 

#define New_V AL_BUP ((valBuf_x< MAX_V AL_BUF)? valBuftvalBuf_x++] : 

(valBuf_x= 0, valBuflvalBuf_x++])) 

//#define STRDUP(str) (strcpy(New_VAL_BUF, (str))) 

#defme STRDUP(str) (strdup(str)) 



/* 

Note that, in flex, predefined char, classes (which must appear within [ ]) include: 



*/ 



%{ 



%} 



UPPER 

LOWER 

ALPHA 

ALNUM 

DIGIT 

SPACE 

*/ 



[A-Z] [:upper:] 
[a-z] [:lower:] 
[a-zA-Z] [:alpha;] 



[A-Za-zO-9] [:alnum:] 



[0-9] 



[:digit:] 



[\\n\\r\\t\\v\\f\\0 ] [:space:] 



%% 

"end var defs" 



{yylval.ival= END_VAR_DEFS; 



retum(END_VAR_DEFS); } 
"freeze" 

retum(FREEZE);} 



{yylval.ival= FREEZE; 
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"succeed" 

retum(SUCCEED);} 
"fail" 

retum(FAIL);} 
"if 

retum(IF);} 
"then" 

retum(THEN);} 
"else" 

retum(ELSE);} 
"elseif 

retum(ELSEIF);} 
"int(" 

retum(INT_PRED);} 
"real(" 

retum(REAL_PRED);} 
"fraction(" 

retum(FRACTION_PRED);} 
"list(" 

retum(LIST_PRED);} 
"eq_vars(" 

retum(EQVARS_PRED);} 
"neq_vars(" 

retum(NEQVARS_PRED);} 



{yylval.ival= SUCCEED; 
{yylval.ival= FAIL; 

{yylval.ival= IF; 
{yylval.ival= THEN; 
{yylval.ival= ELSE; 
{yylval.ival= ELSEIF; 
{yylval.ival= INT_PRED; 
{yylval.ival= REAL_PRED; 
{yylval.ival= FRACTIONPRED; 

{yylval.ival= LIST_PRED; 
{yylval.ival= EQVARS_PRED; 
{yylval.ival= NEQVARS_PRED; 
{yylval.ival= NEQVARVALS_PRED; 



"nec|_varvals(" 
retum(NEQVARVALS_PRED);} 

"optimizable_rel(" {yylval.ival= OPTIMIZABLEREL_PRED; 

retum(OPTIMIZABLEREL_PRED);} 
"step" 

retum(STEP);} 
"symbol(" 

SYMBOL PRED; retum(SYMBOL_PRED);} 



45 



"pi" 

(float)PI; retum(PI);} 
"in" 

IN_SET; retum(IN_SET);} 
"from" 

FROM SET; retum(FROM_SET);} 
"notin" 

NOTIN_SET; retum(NOTIN_SET);} 
"not" 

retum(NOT);} 

11___M 

retum(EQ);} 



{yylval.ival= STEP; 
{yylvaLival= 

{yylvaLfval= 
{yylvaLival= 
{yylval.ival= 
{yylval.ival= 
{yylvaLival= NOT; 
{yylvaLival= EQ; 
{yylvaLival= NEQ; 
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retum(NEQ);} 

retum(GE);} 

retum(LE);} 
"[!" 

EXRANGE_START; retum(EXRANGE_START);} 
[ [ : upp er : ] J [ [ : alnum : ] _] * 
retum(VAR);} 
[[:lower:]][[:alnum:]_]* 
retum(ATOM_CONST);} 
[[:digit:]]*'\"[[:digit:]]+ 
string-rep */retum(RE ALNUM);} 
[[:digit:]]+ 
retum(INTNUM);} 
[[:space:]]+ 

yytext[0]; retum(yytext[0]);} 

%% 

intyywrapQ {retum(l);} 



{yylval.ival= GE; 
{yylval.ival^^ LE; 
{yylval.ival= 
{yylvaLstring= STRDUP(yytext); 
{yylvalstring- STRDUP(yytext); 
{yylval.string= STRDUP(yytext); /* stuffs 
{yylvalival^ atoi(yytext); 
{continue;} 

{yylvaLival= 
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' PrlgExpr.y 

%{ 

/* 

* PrlgExpr.y: Parser for Prolog constraints - to provide functionality for 

* high-level communication, using mathematical expressions, between 

* Prolog IV and other programs (e.g. TCA-GUI). 

* (Use: bison -vd PrlgExpr.y to process it.) 



#include <stdio.h> 
#include <time.h> 
#include <string.h> 
#include <malloc.h> 
#include "p4term.h" 
#include "prlgHLAPI.h" 

// «-- define 
// «~ update it appropriately 



#defme CHECK_CNT 
it to check any buffer-overflows 
#defme VERSION "3.3f' 
#defme P4HLAPILIB "HLP41ib.p4" 



#define TRUE 
#defme FALSE 
#define PI_VAL 
#define MAX(a, b) 
#defme MIN(a, b) 
#defme ABS(x) 
#defme list(elem) 
#defme SAME(x, y) 



1 
0 

(3.14159265) 
((a)>=(b)? (a):(b)) 
((a)<=(b)? (a):(b)) 

((x)>=0? (x): -(x)) 
(cons((elem), NULL)) 
(ABS((x)-(y))<= (Precision)) 



// sizes for some of P4 stacks in terms of cells (1 cell = 8 

bytes) 

#defme P4HEAP_SIZE (1000000) /* 

P4-heap-stack-size in cell (= 8 bytes) counts [default: 700000] */ 
#defme P4CH0ICE_SIZE (300000) /* 

P4-choice-stack-size in cell (= 8 bytes) counts [default: 50000] */ 



#define p4val_rational(T) (p4val_as_double(T)) 

#defme p4val_cstring(T) (p4_symbol_to_cstring(p4val_symbol(T))) 

#ifdefCHECK_CNT 

static P4TERM check_term(P4TERM term)\ 

{if (!term) printf("\n***Received NULL P4TERM***\n");\ 

if (p4ermo!= 0) {printf("\n***Unknown error occurred before the given term was 
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checked;***\n");fflush(stdout);}\ 

return term;} 

#else 

#define check_term(term) (term) 

#endif /* CHECK_CNT */ 

#defme P4MAKE_FUNC_0(func_str) 

check_term(p4make_atom(p4str2symbol(func_str))) 
#defme P4MAKE_FUNC_l(func_str, arg) 
check_term(p4make_functor(l, p4str2symbol(func_str), (arg))) 

#defme P4MAKE_FUNC_2(func_str, argl , arg2) check_term(p4make_functor(2, 
p4str2symbol(func_str), (argl), (arg2))) 
#defme P4MAKE_FUNC_3(ftinc_str, argl, arg2, arg3) 
check_term(p4make_fimctor(3, p4str2symbol(func_str), (argl), (arg2), (arg3))) 
#defme P4MAKE_FUNC_4(func_str, argl, arg2, argS, arg4) 

check_tenn(p4make_functor(4, p4str2symbol(func_str), (argl), (arg2), (arg3), (arg4))) 

#defme P4AND(argl, arg2) ((argl) && 

(arg2)? P4MAKE_FUNC_2(",", argl, arg2); (argl)? (argl): (arg2)) 

#defme P4C0MMA(argl , arg2) (P4AND(argl , 

arg2)) 

#defme P40R(argl , arg2) ((argl) && 

(arg2)? P4MAKE_FUNC_2(";", argl, arg2): (argl)? (argl): (arg2)) 

#defme P4EQ(argl , arg2) ((argl) && 

(arg2)? P4MAKE_FUNC_2("=", argl, arg2): (argl)? (argl): (arg2)) 

#defme P4NEQ(argl, arg2) ((argl) && 

(arg2)? P4MAKE_FUNC_2("dif ', argl, arg2): (argl)? (argl): (arg2)) 

#defme P4IF_THEN(cond_t, thenj) (P4MAKE_FUNC_2("->", condj, 

thenj)) 

#defme P4IF_THEN_ELSE(cond_t, thenj, elsej) (P40R(P4IF_THEN(cond_t, thenj), 

else J)) 

#defme P4IF_THEN_ELSEIF(then_condJ, thenj, else_condJ, else J) 
(P40R(P4AND(then_condJ, thenj), P4AND(else_condJ, else J))) 
#defme P4N0T(arg) 
(P4MAPCE_FUNC_1("\\+", arg)) 
#defme P4CUT 

(P4MAKE_FUNC_0(" ! ")) 
#defme P4TRUE 

(P4MAKE_FUNC_0("true")) 
#defme P4FAIL 

(P4MAKE_FUNC_0("fail")) 
#defme P4FALSE 

(P4FAIL) 

// need to wrap goal in p4call/l before calling p4make_call() (to interpret +12, -12, ...) 
#defme P4MAKE_CALL(goal) (p4make_call(P4MAKE_FlJNC_l ("p4caU", goal))) 
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// due to a bug in p4what_is(), need to call dereference 
#defme P4WHAT_IS(term) (p4what_is(dereference(term))) 



// max. size (in bytes) of an expression passed to the API 
#define MAX_EXPR_SIZE 4096 

// max no. of variables (in one call to Prolog IV) 
#defme M AX_V AR_CNT 1 024 

// max. length of variable name 
#defme MAX__VAR_NAME_LEN 32 

// max-size of the funcTermBuf[] 
#defme MAX_FUNC_TERM_BUF_CNT 128 

// max-size of the anonVarBuf[] 
#defme MAX_ANON_VAR_CNT 128 

// max-size of the constBuf[] 
#defme MAX_CONST_CNT 128 

// max. arity of a functor 
#defme M AX_ARIT Y 1 0 

#defme random rand // MS VC does not 

have random() remove when we can have random() 

#defme srandom srand // MS VC does not 

have srandom()- remove when we can have random() 

//extern void srandom(long); 

//extern long random(); 

extern double atof(); 

//extern int isspace(); 

extern int p4ermo; 

#ifdefPRLGHLAPI 

declspec(dllexport) long AbortPrologSoln; // Flag; if TRUE, Prolog 

constraint-solving-process is aborted 
#else 

long AbortPrologSoln; // Flag; if TRUE, Prolog constraint-solving-process is aborted 
#endif// PRLGHLAPI 

//typedef char BOOLEAN; 

static struct s_rename_struct // used in make_functor() 

{ 

char *func_name, *map_to_name; // for mapping func-names e.g. gcd -> 

gcdtemp 

} FuncRenameList[]= { 

{"ceiling", "ceil"}, 
{"gcd", "gcdtemp"}, 
{"1cm", "Icmtemp"}, 
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{"mod", "modtemp"}, 
{"numden", "numdentemp"}, 

(NULL, NULL} } ; // make sure to end the list with {NULL, NULL} 

typedef struct s__tabelem 

{ // an element ofthe name-key table 

char type; // user-specified type (e.g. int(X)) ofthe variable; 0 if any type will do. 

char ongrid; // flag: true if var-value is to be an integral multiple of its precision; false 
otherwise 

double precision; // precision for the variable 

char name[MAX_VAR_NAME_LEN+l]; // variable name 

P4TERM term; // P4 Prolog term representation for the variable 

struct s_tabelem *next; 

char is_independent_var; // TRUE if the variable is independent (& is not a 

constant); FALSE otherwise 
} TabElem; 

typedef struct s_constant 
{ 

P4TERM term; 
Value value; 
} Const; 

static char inExprBufIMAX_EXPR_SIZE+l ]- {0} ; // buffer to store the incoming 

expression (string) in - for parsing purposes 
static int inExprBuf_x= 0, inExprBuf_cnt= 0; 

#defme INITJnExprBuf {inExprBuf__cnt= inExprBuf__x= 0;} 

// buffer to store func-terms for arity conversion (i.e. X= func(Y, Z). -> X= _R, 
funcCR, Y, Z).) 

static P4TERM funcTermBuflMAX_FUNC_TERM_BUF_CNT]- {NULL}; 
static int funcTermBuf_x= 0; 

#defme INIT^funcTermBuf {funcTermBuf_x= 0; memset(funcTermBuf, 0, 

MAX_FUNC_TERM_BUF_CNT* sizeof(P4TERM));} 

#ifdefCHECK_CNT 

#defme ADD_funcTermBuf(term) {if (funcTermBuf_x< MAX_FUNC_TERM_BUF_CNT) 
funcTermBuflfuncTermBuf_x++]= (term); else {printf("\n***FUNC_TERM_BUF 
overflow***\n");fflush(stdout);} } 
#else 

#defme ADD_funcTermBuf(term) {funcTermBufIfuncTermBuf__x++]= (term);} 
#endif /* CHECK_CNT */ 

#defme FOR_EACH_FUNC_TERM(term) {int _i_func; for(_i_func= 0; _i_func< 

funcTermBuf_x && ((term)- funcTermBufi;_i_func]); J_func++) { 
#defme END_FOR_EACH_FUNC_TERM(term) } } 
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// buffer for anonymous var's used in the functions 
static P4TERM anonVarBuf[MAX_ANON_VAR_CNT]- {NULL}; 
static int anonVarBuf_x= 0; 

#define INIT_anonVarBuf {anonVarBuf_x= 0; memset(anonVarBuf, 0, 

MAX_ANON_VAR_CNT* sizeof(P4TERM));} 

#ifdefCHECK_CNT 

#define ADD_anonVarBuf(anon_term) {if (anonVarBuf_x< MAX_ANON_VAR_CNT) 
anonVarBuflanonVarBuf_x++]= (anonjerm); else {printf("\n***ANON_VAR_BUF 
overflow* * *\n") ;fflush(stdout); } } 
#else 

#define ADD_anonVarBuf(anon_term) {anonVarBuflanonVarBuf_x-H-]= (anonjerm);} 
#endif /* CHECK_CNT */ 

#define FOR_EACH_ANON_VAR(anon_term) {int _i_anon; for(_i_anon= 0; O_anon< 
anonVarBuf_x) && ((anon_term)== anonVarBufLLaiioi^]); _i_anon++) { 
#defme END_FOR_EACH_ANON_VAR(anon_teTm) }} 

// buffer to store number-constant's (with their values) 
static Const constBufIMAX_CONST_CNT]= {0}; 
static int constBuf_x= 0; 

#defme INIT_constBuf {constBuf_x= 0; } 

#ifdefCHECK_CNT 

#defme ADD_constBuf(trm, const_val) {if (constBuf_x< MAX_CONST_CNT) 
{constBuf[constBuf_x].term= (trm); constBuf[constBuf_x].value= (const_val);constBuf_x++;} 
else {printf("\n***CONST_BUF overflow* **\n");fflush(stdout);}} 
#else 

#define ADD_constBuf(trm, const_val) {constBuf[constBuf_x].term= (trm); 
constBuf[constBuf_x].value= (const_val); constBuf_x++;} 
#endif /* CHECK_CNT */ 

// setup to allocate TabElem's from a circular buffer - quick, easy to reinitialize, 
& no need to free up pointers 

static TabElem tabSpace[MAX_VAR_CNT]= {0} ; // space to alloc TabElem from 
static int tabSpace_x= 0; 

// alloc a new TabElem from a circular buffer 
#ifdefCHECK_CNT 

#define NEW_TAB_ELEM ((tabSpace_x< MAX_VAR_CNT)? &tabSpace[tabSpace_x++] : 
(tabSpace_x= 0, printf("\n***tabSpace-buffer overflow***\n"), fflush(stdout), 
&tabSpace[tabSpace_x++])) 
#else 

#define NEW_TAB_ELEM ((tabSpace_x< MAX_VAR_CNT)? &tabSpace[tabSpace_x++]: 
(tabSpace_x= 0, &tabSpace[tabSpace_x++])) 
#endif /* CHECK_CNT */ 

// [re]intialize the table 
#define INITjabSpace {tabSpace_x= 0; memset(tabSpace, 0, 

MAX_VAR_CNT*sizeof(TabElem));} 
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// [hash] table for Var's 
#defme VAR_TABLE_SIZE 53 
static TabElem *varTable[VAR_TABLE_SIZE] = {NULL}; 

// varList: array of var's from the current constraint e.g. X, Y from "X= Y+2, 

Y=6." 

static TabElem *varList[MAX_VAR_CNT]= {NULL}; 
static int varList_x= 0; 

// add the given TabElem-ptr to the varList 
#ifdefCHECK_CNT 

#defme ADD_varList(pJabElem) {if (varList_x< MAX_VAR_CNT) varList[varList_x++]= 

(pJabElem); else {printf("\n***varList-buffer overflow*** V);fflush(stdout);}} 

#else 

#defme ADD_varList(p_tabElem) {varList[varList_x++]= (p_tabElem);} 
#endif /* CHECK_CNT */ 

// [re]intialize the varList 
#defme INIT_varList {varList_x= 0;} 
#defme var_CNT (varList_x) 

// initialize all the variable-related space 
#defme INIT_vars {memset(varTable, 0, 

VAR_TABLE_SIZE*sizeof(TabElem *)); INIT_varList; INITjabSpace;} 

// to do something for each var in current constraint; sets p_tab_elem & its index 

in varList 

#defme FOR_EACH_VAR(p_tab_elem, x) {int _i_var; forC_i_var= 0; ((x)=J_var)< 

var_CNT && ((p_tab_elem)= varList[_i_var]); _i_var^) { 
#define END_FOR_EACH_VAR(p_tab_elem, x) } } 

// buffer for return values 
#defme MAX_VAL_BUF_LEN (1024) 
static Value valBuflMAX_VAL_BUF_LEN]; 
static int valBuf_x= 0; 
#ifdefCHECK_CNT 

#defme NEW_VALUE ((valBuf_x< MAX_VAL_BUF_LEN)? 

&valBuf[valBuf_x++]: (valBuf_x= 0, printf("\n***valBuf-buffer overflow***\n"), 
fflush(stdout), &valBufIvalBuf_x++])) 
#else 

#define NEW_VALUE ((valBuf_x< MAX_VAL_BUF_LEN)? 

&valBufIvalBuf_x++]: (valBuf_x= 0, &valBuf[valBuf_x++])) 

#endif /* CHECK_CNT */ 

#defme INIT_valBuf {valBuf_x= 0;} 

// buffer for enumerated-range terms 
#defme MAX_ENUM_RANGE_TERMS (128) 

static P4TERM enumRangeTermBuf[MAX_ENUM_RANGE_TERMS]= {NULL}; 
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static int enuinRangeTermBuf_x= 0; 

#define enumRangeTermBuf_CNT (enumRangeTermBuf_x) 
#define INIT_enumRangeTermBuf {enumRangeTermBuf_x= 0;} 
#ifdefCHECK_CNT 

#define ADD_ENUM_RANGE_TERM(term) {if (enumRangeTermBuf_x< 
MAX_ENIJM_RANGE_TERMS) enumRangeTermBufi;enumRangeTermBuf_x++]= (term); 
else {printf("\n***enumRangeTermBuf overflow***\n");fflush(stdout);} } 
#else 

#define ADD_ENUM_RANGE_TERM(term) 
{enumRangeTennBuf[enumRangeTermBuf_x++]= (terni); } 
#endif /* CHECK_CNT */ 

#defme ENUM_RANGE_TERM(x) (((x)< enumRangeTermBuf_CNT) && 

((x)>= 0)? enumRangeTemiBufIx]: NULL) 

#define FOR_EACH_ENUM_RANGE_TERM(term, x) {int _i_vrange; for(_i_vrange= 0; 
(((x)=_i_vrange)< enumRangcTermBuf x) && ((term)= enumRangeTemiBufl_i_vrange]); 
_i_vrange++) { 

#define END_FOR_EACH_ENUM_RANGE_TERM(tenn, x) } } 

// swap the positions of the terms (given by their indices in the buffer) in 
the variable-range buffer 

#defme SWAP_ENUM_RANGE_TERMS(term_x, term_y) {P4TERM _t_vrange;\ 

if (((term_x)< enumRangeTermBuf_CNT) && ((term_y)< enumRangeTermBuf_CNT)) {\ 

_t_vrange= enumRangeTermBuf[tenn_x]; enumRangeTemiBuf[term_x]= 
enumRangeTermBuf[term_y] ;\ 

enmnRangeTermBuf[term_x]= _t_vrange;\ 

}} 

// buffer for var-type (e.g. int(X); eq_vars(X, Y); neq_vars(X, Y,Z) ) terms 
#defme MAX_VAR_TYPES_TERMS (128) 

static P4TERM varTypesTermBuf[MAX_VAR_TYPES_TERMS]- {NULL}; 
static int varTypesTermBuf_x= 0; 

#defme varTypesTermBuf_CNT (varTypesTermBuf_x) 
#define INIT_varTypesTermBuf {varTypesTermBuf_x= 0;} 
#ifdefCHECK_CNT 

#defme ADD_VAR_TYPES_TERM(term) {if (varTypesTermBuf_x< 
MAX_VAR_TYPES_TERMS) varTypesTermBuflvarTypesTermBuf_x++]= (term); else 
{printf("\n***varTypesTermBufoverflow***\n");fflush(stdout);}} 
#else 

#defme ADD_VAR_TYPES_TERM(term) {varTypesTermBuflvarTypesTermBuf_x++]= 
(term);} 

#endif /* CHECK_CNT */ 

// buffer for storing solutions so we can return solutions in some (e.g. 
breadth-first) order 

#defme MAX_SOLN_BUF_LEN (1024) 

// the soln-buffer really is an array of vectors of solutions (e.g. [[xl,yl],[x2,y2],...] 
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// (we take the vector-width to be the no. of variables in the constraint== 

varListx) 

static Value solnBufIMAX_SOLN_BUF_LEN]; 

static Value tmpsolnBufi;MAX_SOLN_BUF_LEN/2]; // tmp solution buffer - useful for 
shuffling solutions 

static int solnVec_x= 0, solnCnt= 0, curSoln_x= 0, doBufferSoln= FALSE; 

#define INIT_solnBuf {solnVec_x= 0; solnCnt= 0; curSoln_x= 0; doBufferSoln= 

FALSE;} 

#defme NEW_SOLN_VECTOR ((var_CNT<= 0)? NULLA 

((solnVec_x< 

(int)(MAX_SOLN_BUP_LEN/var_CNT))? &solnBuf[var_CNT*solnVec_x++]: NULL)) 
#defme SOLN_VECTOR_SIZE (var_CNT*sizeof(Value)) 
#define SET_BUF_SOLN_CNT(soln_cnt) {solnCnt= (soln_cnt);} 

// ptr to the value (by its index from the varList) of a variable in specified solution 
(by its index) in the solnBuf 

#define p_VAR_VALUE_in_sotaBuf(soln_x, var x) (((soln_x)>= sohiCnt)? NULL: 
(((var_x)< var_CNT)? &solnBuf[var_CNT*(soln_x)+ (var_x)]: NULL)) 

// ptr to the value (by its index from the varList) of a variable in current-solution 
#defme CUR_BUF_SOLUTION(var_x) p_VAR_VALUE_in_solnBuf(curSoln_x, 
var_x) 

#defme NEXT_BUF_SOLUTION ((curSoln_x>= (solnCnt- 1 ))? NULL: 

&solnBuf[varList_x*-^+curSoln_x]) 

#defme FOR_EACH_SOLN_VECTOR(p_soln_vec, x) {int _i_solnx; for(_i_solnx= 0; 
(((x)=_i_solnx)< solnCnt) && ((p_soln_vec)= &solnBuf[var_CNT*_i_solnx]); _i_solnx++) { 
#defme END_FOR_EACH_SOLN_VECTOR(p_soln_vec, x) } } 

// swap the specified (by their indices) solutions (value-vectors) in the solnBuf 
#defme SWAP_SOLUTIONS(soln_i, solnJ)\ 
if ((soln_i)< solnCnt && (solnJ)< solnCnt)\ 

{\ 

Value tmp; int ^x;\ 

for(_x= 0; _x< var_CNT; _x++)\ 

{\ 

_tmp= *p_VAR_VALUE_in_solnBuf(solnJ, _x);\ 
*p_VAR_VALUE_in_solnBuf(soln_i,_x)= 
*p_VAR_VALUE_in_solnBuf(solnJ,_x);\ 

*p_VAR_VALUE_in_solnBuf(solnJ, _x)= _tmp;\ 

} 

// move the specified (by its from & to-index) solution in the solnBuf 
#defme MOVE_SOLUTION(to_soln_x, from_soln_x)\ 
if ((to_soln_x)< solnCnt && (from_soln_x)< solnCnt)\ 

{\ 

int x;\ 

for(_x= 0; _x< var_CNT; _x++)\ 
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*p_VAR_VALUE_in_solnBuf(to_soln_x,_x)= 
*p_VAR_V ALUE_m_solnBuf(froni_soln_x, _x) ;\ 

}\ 

} 

// copy the specified (by its index) solution from solnBuf into the tmpsolnBuf 
#define COPY_SOLN_to_TMPBUF(soln_i)\ 
if((soln_i)< solnCnt)\ 
{\ 

int x;\ 

forC_x= 0; _x< var_CNT; _x++)\ 

tmpsolnBuf[varList_x*(soln_i)+ x]= *p_VAR_VALUE_in_solnBuf(soln_i, 

_x);\ 

}\ 

} 

II copy the specified (by its from & to-index) solution from tmpsolnBuf into the 

solnBuf 

#defme COPY_SOLN_from_TMPBUF(to_soln_x, fromJmp_soln_x)\ 
if ((to_soln_x)< solnCnt && (from_tmp_soln_x)< solnCnt)\ 

{\ 

int ^x;\ 

for(_x= 0; _x< var_CNT; _x++)\ 

{\ 

*p_VAR_VALUE_in_solnBuf(to_soln_x,__x)= 
tmpsolnBuf[varList_x*(from_tmp_soln_x)+ x] ;\ 

} 



// misc. static var's 

static int semError = 0; // set to non-zero in case of semantic error. 

static BOOLEAN calledStartProlog4 = FALSE; 

static BOOLEAN startedNewProlog4Session= FALSE; 

static int resultFromProlog4= 0; 

static BOOLEAN fractionalizeRational= FALSE; // if TRUE, fractionahze all rationals 

static BOOLEAN roundoffFractionOnlyRational= TRUE; // if TRUE round-off fraction-only 
rationals (e.g. 2/3); otherwise, return fraction-only rationals as fractions 

static char *p4Argv[3]= {"P4LIB", "-banner=off NULL} ; // init-args to Prolog 

IV 

static BOOLEAN useIntervalSolver= FALSE; 
static char curConstraint[MAX_EXPR_SIZE]; 
static double Precision= DEF_PRECISION; 
static BOOLEAN RandomizeConstraints= FALSE; 

static int SolnDiffWt = DEF_SOLN_DIFF_WT; // weight to indicate how 

"different" the solns must be from each other 



PROLOG SCA -24- 



static long BSeed = 1 ; // seed for the random-bit-generator: brandom() 

static BOOLEAN enumerateVarsRandomlyNoHistory = FALSE; // True if independent vars 

are to be enumerated randomly (without keeping track of their past values) 

static int TimedThreadCount= 0; // keeps a running count of active threads 

static HANDLE TimedSolnMutex; // a semaphore to access TimedThreadCount between 

threads 

static BOOLEAN AbortConstraintTimer= FALSE; // a flag to abort constraint-timer 

static BOOLEAN AbortWatchPrologThread = FALSE; // a flag to abort WatchAbortPrologSoln 

thread 

static char *PrologSolnInterruptFile= NULL; // Presence of this file indicates interruption 
of Prolog-solution 

// misc. static declarations 
static BOOLEAN init_solve_constraint(int keep_solns); 
static TabElem *get_var(char '^'var); 
static P4TERM get_var_term(char *var); 
static Value *get_term_value(P4TERM term); 
static List *cons(void *elem, List *lst); 
static List *ncons(List *lst, void *elem); 

static P4SYTVIB0L p4str2symbol(char *str); // pseudo p4-routine 

static P4TERM p4make_atom_from_cstring(char *str); // pseudo p4-routine 

static P4TERM P4Make_Rational(double val); // pseudo p4-routine 

static int p4is_constant(P4TERM term); 

static Value * get_var_value(char *var); 

static P4TERM get_valueJerm(Value *val); 

static int auxSolveConstraint(char ^constraint, int keep_prev_soln, long msec); 

static int h_auxSolveConstraint(char ^constraint, int keep_prev_soln, int enum_vars_randomly, 

long msec); 

static P4TERM make_termhst2term(List *lst); 
static P4TERM make__valshst2term(List *lst); 

static P4TERM combine_terms_array(P4TERM terms[], long size_terms, int do_conjunct, int 
randomize, P4TERM var, int var_eq); 

static P4TERM combine_terms_list(List *terms_lst, int do_conjunct, int randomize, P4TERM 
var, int var_eq); 

static int auxSolveConstraintOrdered(char *constraint, int order_type, int max_soln); 
static double align__val__with_precision(double val, double precision); 
static TabElem *get_term_tabelem(P4TERM term); 
static int getTimedThreadCount(); 

// misc. extem declarations 
extern int yyparse(void); 
extem int yyerror(char *s); 
extem int yylex(void); 
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#ifhdefPRLGHLAPI 

#include "cmn_drvr.c" // driver to test all the stuff out 

#endif /* PRLGHLAPI */ 



// public functions 

char * CCONV GetHLAPIVersionQ 

{// return the current version of the Prolog HL API 

retum(VERSION); 

} 

BSTR CCONV VBGetHLAPIVersionO // wrapper to GetHLAPIVersion() for VB 
{ 

char *c_ver; 
BSTR vb_ver; 

c_ver= GetHLAPIVersionQ; 

vb_ver= SysAllocStringByteLen(NULL, strlen(c_ver)+l); // alloc a new BSTR 
strcpy((char *)vb_ver, c_ver); 

retum(vb_ver); 

} 

DWORD WINAPI watchAbortPrologSoln(void *null) 

{ // watch AbortPrologSoln-variable or the presence-of-Interrupt-file; if either condition 
becomes true, then abort Prolog constraint-solving-process 
#define SLEEP_INTERVAL (2000) // in msec 

extern int accessQ; 

for( Abort WatchPrologThread= FALSE; ! Abort WatchPrologThread; 
SIeep(SLEEP_INTERVAL)) // run until someone turns AbortWatchPrologThread to TRUE 

{ 

if (AbortPrologSoln || (PrologSolnlnterruptFile <&:& (access(PrologSolnInterruptFile, 
0)==0))) 

{ 

prolog_events |= (1L« 16); 
} 

} 

Abort WatchPrologThread^ FALSE; // set if FALSE here as an indicator that this thread is 
finished 

retum(O); 

} 
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int CCONV SetPrologInteiTuptFile(char *interrupt_filename) 

{ // set the filename whose presence interrupts Prolog-solution 

PrologSolnInterruptFile= interrupt_filename? strdup(intermpt_filename): NULL; 

retum(TRUE); 
} 

static int StartProlog4Session_aux(char *p4hlapilib_file, long heapsize, long choicesize) 

{ // starts Prolog IV, return true (1) if ok, false (0) otherwise. 

// p4hlapilib_file is the pathname to the high-level Prolog IV API library file 
// heapsize is the heap-stack size; choicesize is the choice-stack size. 
// ((argc, argv[]) are arguments to Prolog IV.) 

int status, argc; 

char *p4argv[32]= {'T4LIB", NULL} ; // init-args to Prolog IV 

char *banner_arg= "-banner=off '; 

char heapsize_str[32], choicesize_str[32]; 

P4TERM term; 

long dummy, id; 

if (! (TimedSolnMutex- CreateMutex(NULL, FALSE, NULL))) // create a semaphore to 
access TimedThreadCount 
retum(FALSE); 

AbortPrologSoln= FALSE; 

if (!CreateThread(NULL, 0, watchAbortPrologSoln, &dummy, 0, &id)) 
{ 

printf("Unable to create watch-thread\n"); 
retum(FALSE); 

} 

if (!calledStartProlog4) 
{ 

calledStartProlog4 - TRUE; 

p4ermo = 0; // reset ProloglV error-no 

// format arguments for the P4 commandline 

argc= 1; 

p4argv[argc++]= banner_arg; 
p4argv[argc++]= "-heap"; 
sprintf(heapsize_str, "%d", heapsize); 
p4argv[argc++]= heapsize_str; 
p4argv[argc++]= "-choice"; 
sprintf(choicesize_str, "%d'\ choicesize); 
p4argv[argc++]= choicesize_str; 

p4argv[argc]= NULL; 
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status^ (p4init(argc, p4argv)==0); 
if (! status) 

retum(FALSE); 



srandom(time(NULL)) ; 

if (p4hlapilib_file && ! Compile(p4hlapilib_file)) // load High-level 

ProloglV library 

retum(FALSE); 

// set the randomizer-seed in Prolog - from time(NULL) 
p4new_session(); 

term= P4MAKE_FUNC_1 ("randomize", p4make_lint(time(NULL))); 

p4make_call(term); 

status = p4next_solution(); 

if (status=P4SESSI0N_ERR0R) 

return (FALSE); 
p4fmish_session() ; 

#ifdefDO_SETOF_INIT 

// we don't use setof/bagof for now - so, no need to do this initialization 
// initialization to get around a bug in P4 when calhng setof/3 or bagof/3 
p4new_session(); 

term= P4AND(P4MAKE_FUNC_2C'def_array", 
p4make_atom_from_cstring("tab_bagof '), p4make_hnt(l 00)), 

P4AND(P4MAKE_FUNC_2("record", 
p4make_atom_from_cstring("block_Umit"), p4make__lint(0)), 

P4MAKE_FUNC_2("record", 
p4make_atom_from_cstring("last_bag_bound"), p4make_lint(0)))); 
p4make_call(term); 
status = p4next_solution(); 
p4fmish_session(); 

// end-of-initialization to get around a bug in P4 when calling setof73 or bagof/3 
#endif DO_SETOF_INIT 

} 

retum(TRUE); 
} 

int CCONV StartProlog4Session(char *p4hlapilib_file) 

{ // starts Prolog IV, return true (1) if ok, false (0) otherwise. 

// p4hlapilib_file is the pathname to the high-level Prolog IV API library file 

retum(StartProlog4Session_aux(p4hlapilib_file, P4HEAP_SIZE, P4CH0ICE_SIZE)); 

} 
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int CCONV StartProlog4SessionSetStacks(char *p4hlapilib_file, long heapsize, long choicesize) 

{ // starts Prolog IV, return true (1) if ok, false (0) otherwise. 

// p4hlapilib_file is the pathname to the high-level Prolog IV API library file 
// heapsize is the heap-stack size; choicesize is the choice-stack size. 

5 retum(StartProlog4Session_aux(p4hlapilib_file,MAX(heapsize,P4HEAP_SIZE), 
MAX(choicesize, P4CH0ICE_SIZE))); 

} 

int CCONV StartProlog4SessionDefault() 

{ // starts Prolog IV with default parameters, return true (1) if ok, false (0) otherwise. 

1 0 retum(StartProlog4Session_aux("c:\\MyDLL\\HLP41ib.p4", P4HEAP_SIZE, 
P4CH0ICE_SIZE)); 
} 

int CCONV EndProlog4Session() 

{ // end Prolog IV session; return true (1) if ok, false (0) otherwise. 
1 , // Abort all the threads: the WatchAbortPrologSoln, and constraint-timer 

% AbortWatchPrologThread- TRUE; // abort WatchAbortPrologSoln thread 

Abort ConstraintTimer= TRUE; // Abort all previous constraint-timers 
y while(getTimedThreadCount()> 0) // Sleep until all constraint-timer threads are 
j:. finished/aborted 
25:: Sleep(5); 

"ii while(AbortWatchPrologThread) // Sleep until WatchAbortPrologSoln thread is 
1 finished/aborted 
Sleep(5); 

retum(TRUE); 

} 

static char brandom() 

// return a random-bit (0 or 1) (uses BSeed); 

// uses primitive polynomial modulo 2 (PPM2) of degree 18 

{ 

3 0 unsigned char newbit; 



A 
A 
A 



newbit = (BSeed» 1 7) & 1 // bit 1 8 

(BSeed» 4) & 1 
(BSeed» 1) & 1 
(BSeed & 1); 

BSeed = (BSeed« 1) | newbit; // shift bits; put newbit at end 

retum(newbit); 
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} 

static double align_val__withj)recision(double val, double precision) 

// align the given val with the given precision; return the aligned value. 

// (That is, retumed-val= N* precision, (where N is integer) such that |retumed-val - val| is 

minimum 

{ 

int N; 

if (precision== 0) 
retum(val); 

N= (val>= 0)? (int)((val/precision)+0.5): (int)((val/precision)- 0.5); 
val= N* precision; 

retum(val); 

} 

// start-of Thread-related functions 
static int incTimedThreadCount() 

{ // increment the TimedThreadCount; (inside a semaphore because of multithreaded 
access.) 

WaitForSingleObject(TimedSolnMutex, INFINITE); 

TimedThreadCount++; 

ReleaseMutex(TimedSolnMutex); 

retum(O); 

} 

static int decTimedThreadCount() 

{ // decrement the TimedThreadCount; (inside a semaphore because of multithreaded 
access.) 

WaitForSingleObject(TimedSolnMutex, INFINITE); 

TimedThreadCount--; 

ReleaseMutex(TimedSolnMutex); 

retum(O); 
} 

static int getTimedThreadCount() 

{ // return the current TimedThreadCount; (inside a semaphore because of multithreaded 

access.) 

int cnt; 

WaitForSingleObject(TimedSolnMutex, INFINITE); 
cnt= TimedThreadCount; 
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ReleaseMutex(TimedSolnMutex); 

retum(cnt); 
} 

DWORD WINAPI theConstraintTimer(void *p_msec) 
{ 

long msec= *((long *)p_msec); 

// printf(" Going to sleep in the timer\n"); // -- debug 

if (msec> 0) 
{ 

incTimedThreadCount(); // increment the active-thread count 
if (msec<= 1000) 

Sleep(msec); 

else 

{ // check AbortConstraintTimer frequently between sleeps 
long t; 

for(t=0; (t< msec) && ! AbortConstraintTimer; t+= 1000) 
Sleep(lOOO); 

} 

} 

else 

retum(O); 

// printfC'Out of sleep in the timer ... setting prolog_events\n"); // - debug 
prolog_events |= (1L« 16); 

decTimedThreadCount(); // decrement the active-thread count 
retum(O); 

} 

// end-of Thread-related functions 

static int auxSolveConstraint(char ^constraint, int keep j)rev_solns, long msec) 

{ // solve the given constraint (e.g. "X= Y+ 4, Y-2."); 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 

// if keep_prev__solns is true, do not discard the previous solutions 

// if msec> 0, the solver exits in the given max. time (ms) - whether the constraint is 

solved or not 

// return true (=1) [false (=0)] if the constraint is [unjsolvable; 

// returns negative integer in error (e.g. if the constraint could not be parsed, or 
solver aborted), 
int Stat; 
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long id; 



Stat = 0; 

// reset all Prolog flags/events 
resultFromProlog4= 0; 
AbortPrologSoln= FALSE; 
prolog_events= 0; 

if (msec> 0) 

{ // the solution-process must be time-limited 

AbortConstraintTimer= TRUE; // Abort all previous constraint-timers 
while(getTimedThreadCount()> 0) // Sleep until all previous active threads 
finished/aborted 

Sleep(5); 
AbortConstraintTimer^ FALSE; 

prolog_events= 0; // reset all previous Prolog events 

if (!CreateThread(NULL, 0, theConstraintTimer, &msec, 0, &id)) 

{ 

printf("Unable to create thread\n"); 
retum(ERR_UNABLE_TO_CREATE_THREAD); 

} 

} 

if (constraint) 
{ //a new constraint given 
semError= 0; 

if (startedNewProlog4Session) // a goal called previously - end that. 
p4finish_session(); 
// initialize all the tables, spaces, counts; 
if (! init_solve_constraint(keep _prev_solns)) 

retum(ERR_INITIALIZATION); 

// start a new Prolog session 

p4new__session(); 

startedNewProlog4Session= TRUE; 

if ((inExprBuf_cnt- strlen(constraint))> MAX_EXPR_SIZE) 
retum(ERR_CONSTRAINT_TOO_LONG); 

strcpy(inExprBuf, constraint); 
inExprBuf_x= 0; 

stat= yyparseO; 

} 
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else if (calledStartProlog4) // backtrack over the previous result 
{ 

if (semError==0) 

resultFromProlog4= p4next_solutiorL(); 

else 

return (FALSE); 

} 

if (p4ermo!= 0) 
{ 

printf("\n***Unknown error from ProloglV in auxSolveConstraint()***\n"); 
return (ERR_PARSE); 

} 

if (semError= 0 && stat= 0) 
retum((resultFromProlog4= P4SESSI0N_S0LUTI0N)? TRUE: 
(resultFromProlog4-= P4SESSI0N_END)? FALSE: 

(prolog_events!= 0)? ERR_SOLN_INTERRUPTED: 
ERR__PROLOG_SOLVER); 
else if (semError!= 0) 
retum(semError); 
else 

retum(ERR_PARSE); 

} 

static int h_auxSolveConstraint(char * constraint, int keep_prev_solns, int enum_vars_randomly, 
long msec) 

{ // solve the given constraint (e.g. "X- Y+ 4, Y=2."); using a linear/interval solver as 
needed 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 

// if keep__prev_solns is trae, do not discard the previous solutions 

// if enum__vars_randomly is true, enumerate independent vars randomly, without 

keepingtrack of their previous values 

// if msec> 0, the solver exits in the given max. time (ms) - whether the constraint is 

solved or not 

// »(we LOSE track of unique solutions (-cnt) when 

enum_vars_randomly is true.)« 

// return true (=1) [false (=0)] if the constraint is [un]solvable; 

// returns negative integer in error (e.g. if the constraint could not be parsed). 

int Stat; 

if (constraint) 

{ 

if (strlen(constraint)> MAX_EXPR_SIZE) 

retum(ERR_CONSTRAINT_TOO_LONG); 
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strcpy(curConstraint, constraint); 
useIntervalSolver= FALSE; 

enumerateVarsRandomlyNoHistory^ enum_vars_randomly; 

if ((stat=auxSolveConstraint(curConstraint, keep_prev_solns, msec))==0 || (stat> 0 && 
!IsFullyConstrained(NULL))) 

{ 

uselntervalSolver^ TRUE; 

retum(auxSolveConstraint(curConstraint, keep j)rev_solns, msec)); 

} 

retum(stat); 

} 

else 

retum(auxSolveConstraint(NULL, keepjrev^solns, msec)); 

} 

int CCONV SolveConstraint(char ^constraint) 

{ // solve the given constraint (e.g. "X= Y+ 4, Y=2."); using a linear/interval solver as 
needed 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 
// return true (=1) [false (=0)] if the constraint is [unjsolvable; 
// returns negative integer in error (e.g. if the constraint could not be parsed). 
retum(h_auxSolveConstraint(constraint, FALSE, FALSE, -1)); 



int CCONV SolveConstraintRandomly(char *constraint) 

{ // random-solve the given constraint (e.g. "X= Y+ 4, Y=2."); using a hnear/interval solver 
as needed 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 
// » NO track of unique solutions (-cnt) is kept : You may not get unique 
solutions « 

// return true (=1) [false (=0)] if the constraint is [unjsolvable; 

// returns negative integer in error (e.g. if the constraint could not be parsed). 

retum(h_auxSolveConstraint(constraint, FALSE, TRUE, -1)); 
} 

int CCONV TimedSolveConstraint(char ^constraint, long msec) 

{ // solve the given constraint (e.g. "X= Y+ 4, Y=2."); using a hnear/interval solver as 
needed 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 

// ensures that the call finishes in the given time (ms) - whether the constraint is solved or 

not 

// return true (=1) [false (=0)] if the constraint is [unjsolvable; 

// retums negative integer in error (e.g. if the constraint could not be parsed, or 



PROLOG SCA -34- 



could not be solved in given time). 



retum(h_auxSolveConstraint(constraint, FALSE, FALSE, msec)); 
} 

int CCONV TimedSolveConstraintRandomly(char ^constraint, long msec) 

{ // random-solve the given constraint (e.g. "X= Y+ 4, Y=2."); using a linear/interval solver 

as needed 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 
// » NO track of unique solutions (-cnt) is kept : You may not get unique 
solutions « 

// return true (=1) [false (=^0)] if the constraint is [un] solvable; 

// returns negative integer in error (e.g. if the constraint could not be parsed). 

retum(h_auxSolveConstraint(constraint, FALSE, TRUE, msec)); 

} 

static int solution_cmp(const Value *vecl, const Value *vec2) 

{ // compare the two solution-vectors; return >,=,< 0 as vecl >,=,< vec2. 

int i, wt, dist; 

double vail, val2; 

for(i= dist= 0; i< varList_x; i++) 

{ 

wt= varList_x- i; 

vall= (vecl[i].type== VAL_INTEGER)? vecl[i] .value. integer: (vecl[i].type= 
VAL_IRRATIONAL)? (vecl [ij.value.real. lower. val+vecl [ij.value.real. upper. val)/2: 

(vecl[i].type== VAL_REAL |1 vecl[i].type== VAL_RATIONAL_FLOAT || 
vecl[i].type== VAL_RATIONAL_FRACTION)? vecl[i].value.rational.real: 0; 

val2= (vec2[i].type== VAL_INTEGER)? vec2[i].value.mteger: (vec2[i].type= 
VAL IRRATIONAL)? (vec2[i].value.real.lower.val+vec2[i].vaIue.real.upper.val)/2: 

(vec2[i].type= VAL_REAL || vec2[i].type= VAL_RATIONAL_FLOAT || 
vec2[i].type= VAL_RATIONAL_FRACTION)? vec2[i].value.rational.real: 0; 

dist+= (int)(wt*(vall - val2)); // weighted distance 

} 

retum(dist); 
} 

static int auxSolveConstraintOrdered(char *constraint, int order_type, int max_soln) 

{ // solve the given constraint (e.g. "X= Y+ 4, Y==2."); using a linear/interval solver as 

needed 

// solve to find the given no. (= max_soln) of solutions if max_soln is positive; find 
(nearly) all solutions if it is negative 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 
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// Store all the solutions in a buffer, order them (by the given order_type)so we can return 
solutions in an ordered fashion 

// present the solutions conforming to the given order (e.g. ORDER_DIFF_TOGETHER) 

// returns, on first call (i.e. when constraint is non-NULL), (1+ 
the_total_count_of_solutions) (> 0) [false (=0)] if the constraint is [un] solvable; 

// (note that in case of constraints without variables (e.g. "4= 4."), 

total-no.-of-solutions is 0, though the constraint is provable.) 

// returns, on subsequent calls (i.e. when constraint is NULL), true (= 1) [false (=0)] if a 
solution exists [does not exist]; 

// returns negative integer in error (e.g. if the constraint could not be parsed). 

// (The P4 setof/3 & bagof/3 are buggy - hence we simulate them here ourselves.) 
int i, iy, soln_cnt, half_cnt, stat; 
Value *p_vec, *pval; 
TabElem *p_tab_elem; 
int keep__prev_solns; 
extern void qsort(); 

keep_prev_solns= FALSE; 
RandomizeConstraints= FALSE; 
if (constraint) 

{ 

for(soln_cnt= 0; ((max_soln< 0) || (soln_cnt< max_soln)) && ((stat= 
h_auxSolveConstraint(constraint, keepjprev solns, FALSE,- 1))> 0); ) 

{ 

RandomizeConstraints= (order_type==ORDER_UNIQ_SOLUTIONS); // 
randomize (if necessary) var-range-sequences on subsequent calls to solve the constraint 
if (p_vec= NEW_SOLN_VECTOR) 

{ // enough room in the soln-buffer exists -- get the solution- vector 

for the variables 

FOR_EACH_VAR(p_tab_elem, i) 

if (pval= get_var_value(p_tab_elem->name)) 

p_vec[i]= *pval; 
END_FOR_EACH_VAR(p_tab_elem, i) 

4-+soln_cnt; 

SET_BUF_SOLN_CNT(sohi_cnt); 

} 

else // too many solutions (or, zero variables in constraint) to store 
break; 

constraint= (order_type=ORDER_UNIQ_SOLUTIONS)? constraint:NULL; 
keep_prev_solns=(order_type==ORDER_UNIQ_SOLUTIONS); 

} 

doBufferSoln= TRUE; 
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if (soln_cnt<= 2) 

retum(soln_cnt> 0? soln_cnt+l: (stat> 0)? 1: 0); 

switch(order_type) // - order the solutions if so desired — 

case ORDER_LIKE_TOGETHER: // try to gather like solutions together 
qsort(solnBuf, soln cnt, sizeof(Value)*varList_x, solution_cmp); 
break; 



shuffle 



case ORDER RANDOM: // gather solutions in a random sequence - random 

case ORDER_UNIQ_SOLUTIONS: 

for(i= 0, half_cnt= soln_cnt/2; i< half_cnt; i++) 

{ 

iy= half_cnt+ (random()%half_cnt); 
SWAP_SOLUTIONS(i, iy); 

} 

break; 

case ORDER_DIFF_TOGETHER: // try to gather "different" solutions 
together - deterministic shuffle 

if (soln_cnt== 3) 

{ //just swap the last two elements 
SWAP_S0LUTI0NS(1, 2); 
retum(soln_cnt> 0); 

} 

qsort(solnBuf, soln_cnt, sizeof(Value)*varList_x, solution_cmp); 
for(i= 0, half_cnt= soln_cnt/2; i< half_cnt; i++) // intersperse the ordered 



{ // in preparation for shuffle, store the first half of the soln-vectors 

COPY_SOLN_to_TMPBUF(i); 
} 

for(i= 0, half_cnt= soln_cnt/2; i< half_cnt; i-H-) // intersperse the ordered 



solutions 
in tmp-buffer 

solutions 

{ // shuffle by mapping first half as: index-> 2*index, and the 

second half as: index ->2*(index- half_cnt)+l. 

M0VE_S0LUTI0N(2*i+l, i+ half_cnt); 
COPY_SOLN_from_TMPBlJF(2*i, i); 

} 

// after interspersing solutions, add some randomness to it too 
for(i= 0, half_cnt= soln_cnt/2; i< half_cnt; i++) 
{ 

if (brandomO) 

{ 
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iy= half_cnt+ (random()%half_cnt); 

SWAP_SOLUTIONS(i, iy); 

} 

} 

break; 

default: 

break; 

} 

retum(soln_cnt> 0? soln_cnt+l: (stat> 0)? 1: 0); 

else 

{ 

retum(NEXT_BlIF_SOLUTION != NULL); 
} 

} 

int CCONV SolveConstraintOrdered(char *constraint, int order_type) 

{ // solve the given constraint (e.g. "X= Y+ 4, Y=2."); using a linear/interval solver as 

needed 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 

// present the (nearly) ALL the solutions conforming to the given order (e g 
ORDERDIFFTOGETHER) 

// returns, on first call (i.e. when constraint is non-NULL), (1+ 
theJotal_count_of_solutions) (> 0) [false (=0)] if the constraint is [un]solvable; 

II (note that in case of constraints without variables (e.g. "4= 4."), 

total-no.-of-solutions is 0, though the constraint is provable.) 

// returns, on subsequent calls (i.e. when constraint is NULL), true (= 1) [false (=0)] ifa 
solution exists [does not exist]; 

// returns negative integer in error (e.g. if the constraint could not be parsed). 
retum(auxSolveConstraintOrdered(constraint, order type, -1)); 

int CCONV SolveConstraintOrderedNSolns(char *constraint, int orderjype, int max_soln) 
{ // solve the given constraint (e.g. "X= Y+ 4, Y=2. "); using a linear/interval solver as 
needed 

// solve to find the given maximum no. (= max_soln) of solutions 

// backtracks over the previous solution if the constraint is empty (i.e. NULL) 

// present the solutions conforming to the given order (e.g. ORDER_DIFF_TOGETHER) 

// returns, on first call (i.e. when constraint is non-NULL), (1+ 

the_total_count_of_solutions) (> 0) [false (=0)] if the constraint is [unjsolvable; 

II (note that in case of constraints without variables (e.g. "4= 4."), 

total-no.-of-solufions is 0, though the constraint is provable.) 

// returns, on subsequent calls (i.e. when constraint is NULL), true (= 1) [false (=0)] ifa 
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# 



solution exists [does not exist]; 

// returns negative integer in error (e.g. if the constraint could not be parsed). 
retum(auxSolveConstraintOrdered(constraint, orderjype, max_soln)); 

5 int CCONV SolveConstraintLin(char *constraint) 

{ // solve the given constraint (e.g. "X= Y+ 4, Y=2."); using a linear solver only 
// backtracks over the previous solution if the constraint is empty (i.e. NULL) 
// return true (=1) [false (=0)] if the constraint is [unjsolvable; 
// returns negative integer in error (e.g. if the constraint could not be parsed). 

10 useIntervalSolver= FALSE; 

retum(auxSolveConstraint(constraint, FALSE, -1)); 

int CCONV SetPrecision(doubIe precision) 

{// set the precision for solving the constraint & for the solutions in the real domain 
15 //returns TRUE if ok 

if (precision<= 0) 
£f retum(FALSE); 

Precision^ precision; 

'1; retum(TRUE); 

M } 

Jj int CCONV SetSolnDifrWt(int soln_difrwt) 

{// set the weight to indicate how "different" the solutions must be from each other in 
Q Uniq_Soln_Order 

y II (the higher the weight, the more the solutions are "different" ) 

2il //returns TRUE if ok 
if(soln_dif^wt<0) 
Cf retum(FALSE); 
^==^ SolnDiffWt= soln_diff_wt; 

retum(TRUE); 

} 

int CCONV FractionalizeRational(int do_fractionalize) 

{ // fractionalize all the rationals if do_fractionalize is TRUE; not otherwise (fractionalization 
may slow things down a bit.) 
fractionalizeRational= dofractionalize; 
retum(TRUE); 

} 

int CCONV RoundoffFractionOnlyRational(int do_roundoff) 
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{ // roundoff fraction-only rationals (e.g. 2/3) if do_roundoff is TRUE; otherwise, return 
fraction-only rationals as fractions 
roundoffFractionOnlyRational= do_roundoff; 
retum(TRUE); 

} 

int CCONV IsIndependentVar(char *var) 

{ // return TRUE (1) if the given variable is independent (i.e. specified in an enumerati 
FALSE (0) otherwise 
TabElem *p_tab_elem; 

if (var && (p_tab_elem= get_var(var))) 

retum(p_tab_elem->is_independent_var); 

else 

retum(FALSE); 

} 

Value * CCONV GetValue(char *var) 

{ // return the ptr to the value (in Value structure) of the given variable (e.g. "Area") if 
known; 

// return NULL on error (e.g. unknown varible, or variabe has no value, ...) 

int i; 

Value *val; 

TabElem *p_tab_elem; 
val= NULL; 

if(!doBufferSoln) 

{ 

val= get_var_value(var); 
} 

else 

{ // retrieve appropriate value from the soln-buffer 
FOR_EACH_VAR(p_tab_elem, i) 

if (!strcmp(var, p_tab_elem->name)) 
{ // found the var in varList 
val= CUR_BUF_SOLUTION(i); 
break; 

} 

END_FOR_EACH_VAR(p_tab_elem, i) 

} 

retum(val); 

} 
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long CCONV GetValue_type(Value *val) // return type (e.g. VAL_INTEGER) of the given 
Value; 

{ 

// returns VAL_UNKNOWN in 

error 

retum(val? val->type: VAL_lJNKNOWN); 

} 

long CCONV GetVarValue_type(char *var) // return type (e.g. VAL_INTEGER) of the given 
variable; 

{ 

// returns VAL_UNKNOWN in 

error 

Value *val; 

return ((val= GetValue(var))? val->type: VAL_UNKNOWN); 

} 

long CCONV GetValue_int(Value *val) // return integer value of the given Value structure; 
{ // return 

ERR_GETVALUE_INT in error (e.g. given structure is not integer) 

retum((val && val->type== VAL_INTEGER)? val->value. integer: ERR_GETVALUE_INT); 



Rational CCONV Get Value_rational( Value *val) // return rational value of the given Value 
structure; 

{ // return <ERR_GETVALUE_RAT, 

ERR_GETVALUE_INT, ERR_GETVALUE_INT> in error (e.g. given structure is not rational) 
Rational rat; 

if (val && val->type== VAL_RATIONAL_FLOAT || val && val->type== 
VALRATIONALFRACTION) 
retum(val->value.rational); 
else 

{ 

rat.real= ERR_GETVALUE_RAT; 
rat.num = rat.den = ERR_GETVALUE_INT; 
retum(rat); 
} 

} 

double CCONV GetValue_rational_float(Value *val) // return float rep. of the given 
rational Value 

{ 

retum((val && (val->type= VAL_RATIONAL_FLOAT || val->type= 
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VAL_RATIONAL_FRACTION))? val->value.rational.real: ERR_GETVALUE_RAT); 

long CCONV GetValue_rational_numer(Value *val) 
{ // return numerator of the fractional rep. of the given rational Value 
5 retum((val && val->type== VAL_RATIONAL_FRACTION)? val->value.rational.num: 0); 

long CCONV GetValue_rational_denom(Value *val) 
{ // return denominator of the fractional rep. of the given rational Value 
retum((val && val->type= VAL_RATIONAL FRACTION)? val->value,rational.den- 0)- 
10 } ~ ' ^' 

Real CCONV GetValue_real(Value *val) // return real value (i.e. lower & upper bound) from 
the given non-rational Value structure; 

{ // return <1 , 0> in error (e.g. given structure is not 

real) 

15 Realrl; 

if (val && val->type= VALJRRATIONAL) 
retum(val->value.real); 
:1 ! ^Ise 

{ II error 
2jj rLlower.val= 1; 
4;: rl.upper.val= 0; 

rLlower.is_infmite= rl.upper.isjnfmite- TRUE; 
s retum(rl); 

c:^ } 

} 

% double CCONV GetValue_real_lower(Value *val) // return lower bound for the given 
% non-rational real value 

{ //return ERR GETVALUE REAL in error 

retum(val && val->type= VALJRRATIONAL? 
30 (val->value.real.lower.isJnfinite? ERR_GETVALUE_REAL: 

val->value.real.lower.val): ERR_GETVALUE_REAL)- 

} 

double CCONV GetValue_real_upper(Value *val) // return upper bound for the given 
non-rational real value 

{ // return ERR GETVALUE REAL in error 

retum(val && val->type= VAL_IRRATIONAL? 

(val->value.real.lower.is_infinite? ERR_GETVALUE_REAL: 
val->value.real.upper.val): ERR_GETVALUE_REAL); 
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BSTR CCONV VBGetValue_string(Value *val) // VB wrapper for Get Value stringQ 
{ 

char *c_val; 
BSTR vb_val; 

if(!val) 

return (NULL); 
vb_val= NULL; 

if (c_val= GetValue_string(val)) 
{ 

vb_val= SysAllocStringByteLen(NULL, strlen(c_val)+l); // alloc a new BSTR 

strcpy((char *)vb_val, c_val); 
} 

retum(vb_val); 

} 

BSTR CCONV VBGetVarValue(char *var) // VB wrapper for GetVarValueQ 

char *c_val; 
BSTR vb_val; 

if (!var) 

return (NULL); 
vb_val=NULL; 
if (c_val= GetVarValue(var)) 

{ 

vb_val= SysAllocStringByteLen(NULL, strlen(c_val)+ 1 ); // alloc a new BSTR 

strcpy((char *)vb_val, c_val); 
} 

retum(vb_val); 

} 

char * CCONV GetVarValue(char *var) // return (uniform) string representation of 

the given variable 

{ // returns NULL in error 

Value *val; 

if (!var) 

return (NULL); 

return ((val= GetValue(var))? GetValue_string(val): NULL); 
} 
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int CCONV GetVarValueBuf(char *var, int valuebuf_len, char valuebufi]) // 
return (uniform) string representation of the given variable in the value-buffer 

( // returns length (>0) of 

the value in the valuebuf; returns 0 in error 
Value *val; 
char *val_str; 
int val_len; 

if (!var II [valuebuf || valuebuf Jen<= 0) 

return (-1); 
if (valuebuf_len> 0) 

valuebuf[0]= 0; 
val_str= (val= GetValue(var))? GetValue_string(val): NULL; 
val_len= val_str? strlen(val_str): 0; 
if ((vaLlen> 0) && (valuebuf Jen> valjen)) 

{ 

strcpy (valuebuf, val_str); 
free(val_str); 

} 

else 

return (-1); 

return (val_len); 
} 

char * CCONV GetValue_string(Value *val) // return (uniform) string representation of 

the given Value structure 

{ // return NULL in error (e.g. given structure is not valid) 
char str[1024], *p_tmp; 
List *lst; 

if(!val) 

retum(NULL); 
switch(val->type) 

{ 

case VAL_INTEGER: 

sprintf(str, "%ld", val->value.integer); 
break; 

case VAL_RATIONAL_FLOAT: 

sprintf(str, "%f \ val->value.rational.real); 
break; 

case VAL_RATIONAL_FRACTION: 
if (val->value,rational.den 1) 
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sprintf(str, "%d/%d", val->value.rational.num, val->value.rationaLden); 
else 

sprintf(str, "%d", val->value.rationaLnum); 
break; 

case VALJRRATIONAL: 

if (val->value.real.lower.is_infinite) 

sprintf(str, "(<--, "); 
else 

sprintf(str, '\%f, val->value.reaLlower.val); 
if (val->value.real.upper.is_infmite) 

sprintf(str+strlen(str), "-->)"); 
else 

sprintf(str+strlen(str), "%f)", val->value.real.upper.val); 
break; 

case VAL_VAR: 

strcpy(str, "_"); 
break; 

case VAL_STRING: 

strcpy(str, val-> value. string); 
break; 

case VAL_FUNCTOR: 

sprintf(str, "%s/%d", val->value.functor.predicate, val->value,functor.arity); 
break; 

case VAL_LIST: 

strcpy(str, "["); 

for(lst= val->value.list; 1st; lst= lst->next) 

{ 

if (p Jmp= GetValue_string((Value *)lst->elem)) 
strcat(str, p_tmp); 

if (lst->next) 

strcat(str, "); 

} 

strcat(str, "]"); 
break; 

default; 

retum(NULL); 

} 

re1:um(strdup(str)); 
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} 



int CCONV IsFullyConstrained(char ^constraint) 

{ // returns TRUE if the given constraint is fully constrained (i.e. solvable & all variables are 
constant); FALSE otherwise (or in error) 

// (Check the immediately previous constraint if the given constraint is NULL.) 

// Note: It works only for the linear constraints because we use the linear-solver only here. 
// As such, it labels nonlinear constraints such as: Y^2= 2. as 

unconstrained. 

// The trouble with using interval-solver is that it may take a long 

time 

to solve unconstrained equations e.g. Y+ 2. (because it finds 

all the solutions at once.) 
int i; 

Value *pval; 
TabElem *p_tab_elem; 

if (Iconstraint || SolveConstraintLin(constraint)> 0) 
{ 

FOR_EACH_VAR(p_tab_elem, i) 

if (pval= doBufferSoln? CUR^BUF_SOLUTION(i): getjerm_value(p_tab_elem->term)) 
{ // ?? should we use get_var_value() here instead of get_term_value() ??? 

if (pval->type== VAL_VAR || 

(pval->type= VALJRRATIONAL && 

(pval->value.real.lower.is_infmite || pval->value,real.upper.is_infinite && 
ABS(pval->value.reaLupper.val- pval->value.real. lower. val)> 
p_tab_elem->precision))) 
break; 

} 

END_FOR_EACH_VAR(p_tab_elem, i) 
retum(i>= var_CNT); // true if all var's are constant 
} 

else 

retum(FALSE); 

} 

BSTR CCONV VBPrintAUVarValsO // VB wrapper (almost) for PrintAllVarVals() 

char*c_val, buf[1024]; 
BSTR vb_val; 

vb_val= NULL; 

if (c_val= PrintAllVarVals(buf)) 

{ 

vb_val= SysAllocStringByteLen(NULL, strlen(c_val)+l); // alloc a new BSTR 
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strcpy((char *)vb_val, c_val); 
} 

retum(vb_val); 

} 

char * CCONV PrintAlIVarVals(char buf[]) 

{ // Print all the var's with their values in the given buffer; return ptr to the given buffer 
// (assumes buffer is large enough to store all the var's.) 
int i; 

TabElem *p_tab_elem; 
char tmp[256]; 

if(!buf) 
retum(NULL); 
buf[0]= 0; 

FOR_EACH_VAR(p_tab_elem, i) 

sprintf(tmp, "%s: %s, p_tab_elem->name, GetValue_string(GetVaIue(p_tab_elem->name))); 

strcat(buf, tmp); 
END_FOR_EACH_VAR(p Jab_elem, i) 
if(strlen(buf)>=2) 

buf[strlen(buf)-2]= 0; // remove the last comma 

retum(buf); 
) 

char * CCONV PrintAllVarValsAllocate() 

{ // Print all the var's with their values in an allocated buffer; return ptr to the given buffer 
charbuf[2048]; 

PrintAllVarVals(buf); 

retum(strdup(buf)); 
} 

int CCONV Compile(char *p4_filename) // compile & load the given p4_filename 
(containing Prolog IV program) 

{ // return true (1) if the file compiled ok, false (0) in error 
int Stat; 

p4new_session(); 

p4make_call(P4MAKE_FUNC_l("compile",p4make_atom_fi:om_cstring(p4_filename))); 

stat= (p4next_solution()== P4SESSI0N_S0LUTI0N); 

p4fmish_session(); 
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retum(stat); 
} 



static int term_numden(P4TERM term, int *num, int *den) 

{ // performs fractional representation for the given rational term i.e. rational= num/den (e g 4 5 
9/2) 

// uses numden/3 to achieve that, (note that you can call a Prolog predicate in the middle of 
another - in a recursive fashion.) 

// puts the numerator in the given num, and denominator in den. 
// returns TRUE if succeeded in doing the transformation, FALSE otherwise, 
int Stat; 

P4TERM tnum, tden; 

if(!term) 

retum(FALSE); 
*num^ *den^ 0; 

p4new_session(); // note that we start a session before making new terms - these new terms are 

valid only for this session 

tnum= check_term(p4make_var()); 

tden= check_term(p4make_var()); 

p4make_call(P4MAKE_FUNC_3("numden", term, tnum, tden)); 

if ((stat= (p4next_solution()= P4SESSI0N_S0LUTI0N)) && p4is_integer(tnum) && 
p4is_integer(tden)) 

{ 

*num^ p4val_lint(tnum); 
*den= p4val_lint(tden); 
} 

p4fmish_session(); 

retum(stat); 
} 

static int numden(double rational, int *num, int *den) 

{ // performs fractional representation for the given rational number i.e. rational^ num/den (e.g. 
4.5= 9/2) 

// uses numden/3 to achieve that, (note that you can call a Prolog predicate in the middle of 
another - in a recursive fashion.) 

// puts the numerator in the given num, and denominator in den. 

// returns TRUE if succeeded in doing the transformation, FALSE otherwise. 

retum(term_numden(check_term(P4Make_Rational(rational)), num, den)); 
} 
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static int gcd(int x, int y) 

{ // return the GCD of the two given integers 

int num, den, tmp; 

if(x<y) 
{ // swap X & y 
tmp= x; 
x= y; 
y= x; 
} 

if(x=0|| y==0||x==l ||y-=l) 

retum(l); 
if(x==y||x=(-y)) 

retum(x); 

if (numden(((double)x)/y, &num, &den)) 

retum((int)(x/num)); 
else 

retum(l); 

} 



// private functions 

int GetInString(char buf[], int max_size) // used in lexer - make it static later 

{ // put input string (upto max_size) in the given buf[]; (usually called by YY_INPUT from 

lexical analyzer) 

// return the no. of char's actually put in buf[]. (returns 0 if no char's put.) 
int out_cnt; 

out_cnt= MIN(max_size, (inExprBuf_cnt- inExprBuf_x)); // max, no. of char's to put in bufi] 
memcpy(buf, inExprBuf+inExprBuf_x, out_cnt); 
inExprBuf_x out_cnt; 

retum(out_cnt); 

} 

static int bounds_of__real_var(P4TERM var, Real *realp) 

{ // find the lower & upper bounds of the given (numeric) (real) var; 

// return true (1) on success; false (0) on failure (e.g. given var is not numeric) 
// (much of this func suggested by Pascal Bouvier of Prologianet) 
// (we use glb/2 & lub/2 instead of bounds/3 so we can assign the 
// infmite-bound to the appropriate end (i.e. lower/upper)) 

P4TERM tA, tB; 

int done, status; 
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done= FALSE; 

realp->lower.is_infinite= realp->upper.is_infinite= FALSE; 
realp->lower.val= realp->upper.val= 0; 

// well, for efficiency, let's use bounds/3 to check if the var is unbounded on either side 
p4new_session(); 
tA = p4make_var(); 
tB = p4make_var(); 

p4make_call(P4MAKE_FUNC_3C'bounds", var, tA, tB)); 
if ((status- p4next_solution())!- P4SESSI0N_S0LUTI0N) 

{ 

if (status !- P4SESSI0N_ERR0R) 

realp->lower.is_infmite= realp->upper.is_infmite= TRUE; // «- KNJ: This is 
not strictly correct, REVISIT it later --» 
else 

{printf("\n'*'*'^ Encountered error 1 in 
bounds_of_real_var()***\n");fflush(stdout);} 
done= TRUE; 

} 

p4finish_session(); 
if (done) 

return(TRUE); 

// first, check if the given var. is really unbounded on the lower side 
p4new_session(); 

p4make_call(P4MAKE_FUNC_2("lt", var,P4Make_Rational(DEF_LOWER_BOUM)))); 
if ((status= p4next_solution())= P4SESSI0N_S0LUTI0N) 

{ 

realp->lower.is_infinite= TRUE; 
} 

else 

{ // not unbounded on the lower side - find the actual lower bound 
if (status= P4SESSI0N_ERR0R) 

{printf("\n***Encountered error 2 in 
bounds_of_real_var() * * *\n") ; fflush(stdout) ; } 

p4finish_session(); 
p4new__session(); 
tA ^ p4make_var(); 

p4make_call(P4MAKE_FUNC_2("glb", var, tA)); // get the lower bound 
switch(p4next_solution()) 

{ 

case P4SESSI0N_END: realp->lower.is_infinite= TRUE; break; // 
solution - the bound is infinite 

case P4SESSI0N_S0LUTI0N: realp->lower.val= p4val_rational(tA); 
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realp->lower.is_infinite= 

SAME(realp->lower.val, DEF_LOWER_BOUND) || 



DEF_LOWER_BOUND); 



(realp->lower.val< 



break; 

case P4SESSI0N_ERR0R: // error - given var may be 

non-numeric 

default: retum(FALSE); 

} 

} 

p4fmish_session(); 

// next, check if the given var. is really unbounded on the upper side 
p4new_session() ; 

p4make_call(P4MAKE_FUNC_2("gt", var, P4Make_Rational(DEF_UPPER_BOUND))); 
if ((status= p4next_solution())== P4SESSI0N_S0LUTI0N) 

{ 

realp->upper,is_infinite= TRUE; 

} 

else 

{ // not unbounded on the upper side - find the actual upper bound 
if (status— P4SESSI0N_ERR0R) 

{printf("\n***Encountered error 3 in 
bounds_of_real_var()***\n");fflush(stdout);} 

p4finish_session(); 
p4new_session(); 
tA = p4make_var(); 

p4make_call(P4MAKE_FUNC_2("lub", var, tA)); // get the upper bound 
switch(p4next_solution()) 

{ 

case P4SESSI0N_END: realp->upper.is_infmite= TRUE; break; // 

solution - the bound is infinite 

case P4SESSI0N_S0LUTI0N: realp->upper.val= p4val_rational(tA); 

realp->upper.is_infinite= 

SAME(realp->upper.val, DEF_UPPER_BOUND) || 

(realp->lower.val> 

DEF_UPPER_BOUND); 

break; 

case P4SESSI0N_ERR0R: // error - given var may be 

non-numeric 

default: retum(FALSE); 
} 
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} 

p4finish_session(); 



retum(TRUE); 

} 

Static P4TERM get_value_term(Value *val) 

{ // return the Prolog IV term for the given basic value (in Value struct) 
if(!val) 
retum(NULL); 
switch(val->type) 

{ 

case VAL_INTEGER: retum(check_term(p4make_lint(val->value, integer))); break; 
case VAL_RATIONAL_FLOAT: 
retum(check_term(P4Make_Rational(val->value.rational.real))); break; 
case VALJlATIONAL_FRACTION: 

retum(((val->value.rationaLden != 1) && (val->value.rationaLden != 0))? 

check_terni(P4Make_Rational((double)val->value.rationaLnunV(double)val->valueTational.den^ 
): 

check_tenn(P4Make_Rational((double)val->value.rationaLnum))); 
break; 

case VAL_IRRATIONAL: // ?? what is the P4-call to make a P4term for an irrational 

??? 

retum(NULL); break; 
case VAL_VAR: retum(NULL); break; 
case VAL_STRING: 
retum(check_term(p4make_atom_from_cstring(val->value.string))); break; 

case VAL_FUNCTOR: // ?? what is the P4-call to make a P4term for a functor ??? 
retum(NULL); break; 
case VAL_LIST: retum(check_term(make_valslist2term(val->valueiist))); break; 

default: retum(NULL); 
} 

retum(NULL); 
} 

static Value * get_var_value(char *var) 

{ // return the (ptr to) value (in Value struct) of the given ProloglV variable 
// (It finds the basic value through get_term_value(), and 

// then interprets that further for the given var & its type (e.g. precision/type considerations) 

) 

TabElem *p_tab_elem; 
Value *val; 
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if (!var) 

retum(NULL); 

if (!(pjab_elem= get_var(var)) || !(val= get_term_value((P4TERM)p_tab_elem->term))) 
{ 

if(!val) 

{printf("\n***Recvd NULL value for the given variable %s;***\n", 
var);fflush(stdout); } 
retum(NULL); 
} 

switch(val->type) 
{ 

case VAL_VAR: 

/* «- KNJ: ignore all this for now - for efficiency's sake -- REVISIT it later 

-» 

if (uselntervalSolver && bounds_of_real_var((P4TERM)p_tab_elem->term, 
&val->value.real)) 

{ 

val->type= VALJRRATIONAL; 

if (!val->value.real.lower.is_infinite && 

!val->value.reaLupper.is__infinite && 
ABS(val->value.reaI. upper. val- val->value.reaLlower.val)<= 
p_tab_elem->precision) 

{ // the range is smaller than the variable's precision - it can be represented 

as a rational 

val->type= VAL_RATIONAL__FLOAT; 
val->value.rationaLreal= (val->value.reaL lower. val+ 
val->value.real.upper.val)/2; 

val->value.rationaLnum= val->value.rationaLden= 0; 
if (p_tab_elem->type=- VAL_RATIONAL_FRACTION) 
{ 

numden(val->value.rationaLreal, &val->value.rationaLnum, 

&val->value. rational . den) ; 

val->type= VAL_RATIONAL__FRACTION; 
} 

} 

} 

*/ 

break; 

case VALJRRATIONAL: 
#ifdef OLDJRRATIONAL 

if (!val->value.real.lower.is_infinite && 

!val->value.real,upper.is_infinite && 
ABS(val->value.real.upper.val- val->value.real. lower, val)<= 
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p_tab_elem->precision) 

{ // the range is smaller than the variable's precision - it can be represented as a rational 
// this introduces errors (due to roundoff) which, however small, are 
unacceptable for ETS work 

val->type- VAL_RATIONAL_FLOAT; 

val->value.rational.real^ aUgn_val_withj)recision((val->value.real.lower.val+ 
val->value.reaLupper.val)/2, p_tab_elem->precision); 

val->value.rational.num= val-> value, rational. den= 0; 

if (p Jab_elem->type= VAL_RATIONAL_FRACTION) 

{ 

numden(val->value.rational.real, &val->value.rational.num, 
&val->value.rational.den); 

val->type= VAL_RATIONAL_FRACTION; 
} 

} 

#endif /* OLDJRRATIONAL */ 
break; 

case VAL_RATIONAL_FLOAT: 

val->value.rational.real= align_vaI_with_precision(val->value.rational.real, 
p_tab_elem->precision); 

if (p_tab_elem->type= VAL_RATIONAL_FRACTION) 

{ 

numden(val->value.rational.real, &val->value.rational.niim, &val->value.rational.den); 

val->type= VAL_RATIONAL_FRACTION; 

} 

break; 

default: 

break; 

} 

retum(val); 
} 

static int are_equal_terms(P4TERM tennl, P4TERM term2) 
{ // returns true if the two given terms are equal 
int Stat; 

if (Iterml || !term2) 

retum(FALSE); 

p4new_session(); 

p4make_call(P4EQ(terml, term2)); 

stat= (p4next_solution()== P4SESSI0N_S0LUTI0N); 
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p4finish_session(); 



retum(stat); 
} 

static Value *get__tenn_value(P4TERM term) 

{ // return the basic value (in Value struct) of the given Prolog IV term 
Value *val, *p_tmp__val; 
int term_type; 

if (!term || p4is_nil(term)) 
retum(NIJLL); 

//val= (Value *)calloc(l, sizeof( Value)); 
val- NEW_VALUE; 
switch(termjype= P4WHATJS(term)) 
{ 

case P4INTEGER: 

val->type- VAL_INTEGER; 
val->value.integer= p4val_lint(term); 
break; 

case P4FLOAT: 

val->type= VAL_RATIONAL_FLOAT; 
val->value.rational.real= p4val_double(term); 
val->value.rational.num= val->value.rationaLden= 0; 
break; 

case P4RATI0NAL: 

val->type- VAL_RATIONAL_FLOAT; 
val->value.rationaLreal= p4val_rational(term); 
if (IroundoffFractionOnlyRational && !are_equal_terms(term, 
check_term(P4Make__Rational(val->value.rational.real)))) 

{ // if the rational cannot be represented in non- fractional terms 
val->type= VAL_RATIONAL_FRACTION; 

term_numden(term, &val->value.rational.num, &val-> value. rational. den); 
} 

break; 

case P4AT0M: 

val->type= VAL_STRING; 

val->value.string= p4val_cstring(term); // do we need to realloc the string ? 
break; 

case P4D0T: 
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val->type= VAL_LIST; 

p_tmp__val= get_term_value(p4cdr(term)); 

val->value.list= cons(get_term_value(p4car(term)), p_tmp_val? p_tmp_val->value.list 
NULL); 

break; 

case P4FUNCT0R: 

val->type= VAL^FUNCTOR; 

val->value. functor.predicate= p4val_cstring(term) ; 

val->value. functor. arity= p4get_arity(term) ; 

break; 

case P4VAR: 

val->type= VAL_VAR; 

if (boimds_of_real_var(term, &val->value.real) && // «- added check: KNJ 
!val->value.real.lower.is_infinite <&& !val->value.real.upper.is_mfinite) 
val->type- VALJRRATIONAL; 
break; 

default: 

printf("\n***Recvd unknown value-type for the given variable; ***\n"); 

fflush(stdout); 

//free(val); 

retum(NULL); 

} 

if (p4ermo!= 0) 

{printf("\n***Unknown error occurred when getting value of a 
variable ; * * *\n") ;fflush(stdout) ; } 

retum(val); 

} 

// aux functions 
static int hash(char *str) 

{ 

int i, h; 

for(i= h= 0; str[i]; i++) h += str[i]*i; 

retum(h% VAR TABLE SIZE); 
} 

static TabElem *get_var(char '^'var) 

{ // ptr to the appropriate variable-entry in the var-table 
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TabElem *p; 

for(p= varTable[hash(var)]; p && p->name && stmcmp(p->name, var, 
MAX_VAR_NAME_LEN); p= p->next); 
retum(p); 
5 } 

Static P4TERM get_var_term(char *var) 

{ // return the term associated with the variable 

TabElem "^p; 

p= get_var(var); 
1 0 retum(p? (P4TERM)p->term: NULL); 

} 

static TabElem '^get_term_tabelem(P4TERM term) 

{ // return the var-table-element associated with the given term 

int i; 

1.^;, TabElem *^p_tab_elem; 

FOR_EACH^VAR(p_tab_elem, i) 
if (p_tab_elem->term=^^ term) 

retum(p_tab_elem); 
il END_FOR_EACH_VAR(p_tab_elem, i) 

retum(NULL); 

h } 

static int set_term_on_grid(P4TERM term) 

TabElem *p_tab_elem; 
2|v3 if (p_tab_elem= get_term__tabelem(term)) 
p_tab_elem->ongrid= TRUE; 

return TRUE; 

} 

static int reset_tenn_on_grid(P4TERM term) 
30 { 

TabElem *p_tab_elem; 
if (p_tab_elem= get_term_tabelem(terai)) 
p_tab_elem->ongrid= FALSE; 

return TRUE; 
35 } 
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static void insert_const(P4TERM term, Value *const_value) 

{ // insert the given {term, constant value} pair in constBuf[] 

ADD_constBuf(tenn, *const_value); 

return; 

} 

static Value *get_const_value(P4TERM term) 

{ // return the Value associated with the given term if the term is numeric-constant; NULL 

otherwise. 

int i; 

for(i= 0; (i< constBuf_x) && (constBufliJ.term term); i++); 

retum((i< constBuf_x)? &constBuf[i] .value: NULL); 

} 

static P4TERM insert_var(char *var) 

{ // insert given var (with an associated Prolog term) to the var-table if not already present 

// return ptr to the term associated with the var. 
TabElem *p; 
int h; 

if(!strcmp(var, "_")) 
{ // anonymous variable - just return a Term for it 
retum(check_t erm(p4make_var())) ; 

} 

else if (!(p= get_var(var))) 
{ // non-anonymous variable - store in variable table 
p= NEW_TAB_ELEM; 

// initialize variable to default type 
p->type= DEF_VAR_TYPE; // <- actual type (e.g. int, ...) may be put later 

p->is_independent_var ^ FALSE; 
p->precision= DEF_PRECISION; 
p->ongrid= DEF_GRID; 

stmcpy(p->name, var, MAX_VAR_NAME_LEN); 

p->term= check_term(p4make_var()); 

p->next= varTable[h= hash(var)]; 

varTable[h]= p; 

ADD_varList(p); 

} 

retum((P4TERM)p->term); 

} 

static P4TERM insert_var_with_precision(char *var, double precision) 

{ // insert (or modify its attribs if preexistent) given var (with an associated Prolog term) to the 
var-table; 
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// (attach the given precision to the variable) 

// return ptr to the term associated with the var. 
TabElem *p; 
int h; 

if (!(p= get_var(var))) 

{ 

p= NEW_TAB_ELEM; 

// initialize variable to default type 
p->type= DEF_VAR_TYPE; // <- actual type (e.g. int, ...) may be put later 

p->is_independent_var = FALSE; 
p->ongrid= DEF_GRID; 

stmcpy(p->name, var, MAX_VAR_NAME_LEN); 

p->tenn= check_term(p4make_var()); 

p->next= varTable[h= hash(var)]; 

varTable[h]= p; 

ADD_varList(p); 

} 

p->precision= precision; 

retum((P4TERM)p->term); 

} 

Static int mark_var_type(char ^var^ int type) 

{ // mark the type of the given variable; return TRUE if ok, FALSE in error 
TabElem *p; 

if (!(p== get_var(var))) 

retum(FALSE); 
p->type= type; 

retum(TRUE); 
} 

static int mark_term_var_type(P4TERM term, int type) 

// mark the type of the given term (in the var-table) as given; 

// returns TRUE if the action done successfully; FALSE otherwise. 

{ 

TabElem *p_tab_elem; 

if (p_tab_elem= get_term__tabelem(term)) 
{ 

p_tab_elem->type= type; 
retum(TRUE); 
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} 

else 

retum(FALSE); 

} 

static int mark__term_list_type(List *var_lst, int type) 

{ // mark the type of the variables in the given variable-term-list; return TRUE if ok, 
FALSE in error 

for( ; var_lst; var_lst= var_lst->next) 
mark_term_var_type((char *)var_lst->elem, type); 

retum(TRUE); 
} 

static List *cons(void *elem, List *lst) 

{ // cons the given elem to the [front of the] list 

List *p; 

if (!elem) 
retum(lst); 

if (p= calloc(l, sizeof(List))) 

{ 

p->elem= elem; 
p->next^ 1st; 

p->elem_cnt= 1st? lst->elem_cnt+l: 1; 

} 

else 

{ 

printf("\n***Unable to calloc List in cons()***\n");fflush(stdout); 
retum(NULL); 

} 

retum(p); 

} 

static List *ncons(List *lst, void *elem) 

{ II neons the given elem to the [end of the] list 

List *p, *1; 

if (!elem) 
retum(lst); 
if (p= calloc(l, sizeof(List))) 

{ 

p->elem= elem; 
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p->next== NULL; 
p->elem_cnt= 1; 
} 

else 
{ 

printf("\n***Unable to calloc List in ncons()***\n");fflush(stdout); 
retum(NULL); 
} 

if (1st) 
{ 

lst->elem_cnt++; 

for(l= 1st; l->next; 1= l->next); 

l->next= p; 

} 

else 
lst= p; 

retum(lst); 

} 



// — action-routines — 

static int find_setof_soln(P4TERM goal) 
{ // find (& buffer & reorder) the set of solns for the given goal; 
// return the Prolog-returned status of the call 

// Note that the P4 must have been initialized with the following query once before calling 
setof/3 or bagof/3: 

// def_array(tab_bagof, 100), record(block_limit, 0), record(last_bag_bound, 0). 
int i, soln__cnt, status; 
P4TERM var_set, R, vec; 
Value *p_vec; 

if(!doBufferSoln) 
retum(FALSE); 

for(var_set= check_term(p4make_nil()), i= varList_x-l ; i>= 0; i--) // build a term for the set of 
var's 

var_set= check_term(p4make_dot((P4TERM) varList[i]->term, var_set)); 
R= check_term(p4make__var()); 
goal= P4MAKE_FUNC_3("setof var_set, goal, R); 
P4MAKE_CALL(goal); 

if ((status= (p4next_solution()= P4SESSI0N_S0LUTI0N)) && !p4is_ml(R)) 
{ // found the solns - buffer them 
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for(soln_cnt= 0; !p4isjiil(R); R- p4cdr(R)) 
{ 

if (p_vec= NEW_SOLN_VECTOR) 
{ // enough room in the soln-buffer exists 
for(vec= p4car(R), i= 0; !p4is_nil(vec); vec= p4cdr(vec), i++) 
{ 

p_vec[i]= '^get_term_value(p4car(vec)); 

} 

soln_cnt++; 

} 

} 

SET_BUF_SOLN_CNT(sota_cnt); 

11 **** j^Q^ about ordering the solutions in next pass 

} 

retum(status); 

} 

static P4TERM split_var_range_terni() 

{ // return the split-var-range term (e.g. intsplit([X, Y]), realsplit([Z])) for the var's in the current 
constraint 

// (useful only while solving with the interval solver.) 
// (we set the default var-type to be real.) 

// NOTE: if the variable is UNBOUND in the clause, a split (intspht/realsplit) 
// may give rise to VB overflow ! ! 

int i; 

P4TERM lst_term, term, intsplit, realsplit; 
//P4TERM anon; 
TabElem *p_tab_elem; 

if (luselntervalSolver) // can we use intsplit/realsplit outside of the interval-solver 

?N0 

retum(NULL); 

intspHt= realsplit= NULL; 
FOR_EACH_VAR(p_tab_elem, i) 
switch(p__tab_elem->type) 

{ 

case VAL_INTEGER: 

lst_term= check_term(p4make_dot(p_tab_elem->term, p4make_nil())); // X -> [X] 

term= P4MAKE_FUNC_3(" intsplit", Istjerm, 
check_term(p4make_atom_from_cstring("smallest_domain")), 
check_term(P4Make_Rational(p_tab_elem->precision))); 

intsplit= P4AND(intsplit, term); 

break; 
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case VALRATIONALFLOAT: 
case VAL_RATIONAL_FRACTION: 
case VALJRRATIONAL: 
case VAL_REAL: 

lst_term= check_term(p4make_dot(p_tab_elem->term, p4make_nil())); // X -> [X] 

tenn= P4MAKE_FUNC_3("realsplit", Istjerm, 
check_term(p4make_atom_from_cstring(''smallest_domain'')), 
check_term(P4Make_Rational(p_tab_elem->precision))); 

realsplit= P4AND(realsplit, term); 

break; 

case VAL_LIST: 
case VALSYMBOL: 
break; 

default: 
break; 

} 

END_FOR_EACH_VAR(p_tab_elem, i) 

// « — how does it work in case the anon var. is noimumber e.g. list ?? 
// NOTE: if the variable is UNBOUND in the clause, a split (intsplit/realspUt) may give 
rise to VB overflow ! ! 

#ifdef NOIGNORE_ANON_SPLIT // don't do it until really needed 

FOR_EACH_ANON_VAR(anon) 

lst_term= p4make_dot(anon, p4make_nil()); // X -> [X] 

term= P4MAKE_FUNC_3("realsplit", IstJerm, 
p4make_atom_from_cstring("smallest_domain")); 

realsplit= realsplit? P4AND(realsplit, term): term; 
END_FOR_EACH_ANON_VAR(anon) 
#endif /* NOIGNORE_ANON_SPLIT */ 

retum(P4AND(intsplit, realsplit)); 

} 

Static P4TERM set_var_bounds_term() 

{ // return the term setting bounds (e.g. -BOUND < X < BOUND) for all the variables used in the 
constraint 

// (useful only for the interval solver.) 

// (ideally, we should first check to see if the var has a bound already set in the constraint. 
// only when no such bound is set should we set a default one. 
int i; 

P4TERM term, bound; 
//P4TERM anon; 
TabElem *p_tab_elem; 
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i f ( ! uselntervalSolver) 
retum(NULL); 

tenn= NULL; 

FOR_EACH_VAR(p_tab_elem, i) 

if (p_tab_elem->type= VAL_INTEGER || p_tab_elem->type== VAL_REAL || 

p_tab_elem->type= VAL_RATIONAL_FLOAT || p_tab_elem->type= 
VAL_RATIONAL_FRACTION) 

{ 

bound= P4MAKE_FUNC_3("cc", p_tab_elem->term, 
check_term(P4Make_Rational(DEF_LOWER_B0UND)), 
check_term(P4Make_Rational(DEF _UPPER_BOUND))); 

tenn= P4AND(term, bound); 

} 

END_FOR_EACH_VAR(p_tab_elem, i) 

// « — KNJ: try removing the constraints on anonymous var's « — 
//FOR_EACH_ANON_VAR(anon) 

// bound=P4MAKE_FUNC_3("cc", anon, P4Make_Rational(DEF_LOWER_BOUND), 

P4Make_Rational(DEF_UPPER_BOUND)); 

// term= P4AND(term, bound); 

//END_FOR_EACH_ANON_VAR(anon) 

// « — KNJ: try removing the constraints on anonymous var's « — 

retum(term); 
} 

Static P4TERM vars_multiple_of_precision_term() 

{ // return a term binding variables to be integer-multiples of their precision 
// (e.g. int(_N), X= _N* X_precision) 
//NOTE: This constraint excludes irrational variables (e.g. PI)! 

int i; 

P4TERM term, t; 
TabElem *p_tab_elem; 

term= NULL; 

FOR_EACH_VAR(p Jab_elem, i) 

if (p_tab_elem->ongrid && (p_tab_elem->type== VAL_REAL || p_tab_elem->type= 
VAL_RATIONAL_FLOAT || p_tab_elem->type= VAL_RATIONAL_FRACTION)) 

{ // for each variable, add: var_with_precision(Var, Precision). 

t= P4MAKE_FUNC_2("var_with_precision", p_tab__elem->term, 
check_term(P4Make_Rational(p_tab_elem->precision))); 

term= P4AND(term, t); 

} 

END_FOR_EACH_VAR(p Jab_elem, i) 
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retum(term); 
} 

static P4TERM buffered_func_terms() 

{ // return the term containing the buffered functions (e.g. X= mean(X,Y) -> X= _R, 
mean(_R,X,Y), where mean(_R,X,Y) is buffered) 

retum(combine_terms_array(funcTermBuf, funcTermBuf_x, TRUE, FALSE, NULL, FALSE)); 

} 

static P4TERM get_exclude_solutions_tenn(int randomize) 

{ // return a term corresponding to the negation of all the previous solutions of independent 

var's e.g. (X=/= 4, Y=/=5, X=/= 10, Y=/=15). 

TabElem *p_tab_elem; 

P4TERM t, term; 

Value *p_soln_vec; 

int x_var, x_soln_vec; 

int i; 

char exclude_soln; 

term= NULL; 
exclude_soln= TRUE; 
FOR_EACH_VAR(p_tab_elem, x_var) 

if (p_tab_elem->is_independent_var) 

{ // exclude only the variables to be used to generate uniq solns (e.q. 
enumerate variables) 

FOR_EACH_SOLN__VECTOR(p_soln_vec, x_soln_vec) 

if (randomize) // randomize the exclusion of solutions 

for(i=0, exclude__soln= FALSE; !exclude_soln && (i< 

SolnDiffWt); i++) 

exclude_soln= brandom(); 
if (exclude_soln && (t= get_value_term(&p_soln_vec[x_var]))) 

{ 

t= P4NEQ(p_tab_elem->term, t); 
temi= P4AND(term, t); 

} 

END_FOR_EACH_SOLN_VECTOR(p_soln_vec,x_soln_vec) 

} 

END_FOR_EACH_VAR(p_tab_elem, x_var) 

retum(term); 
) 

static P4TERM get_enum_ranges_term(int randomize) 

{ // return a term corresponding to the enumerated-ranges (which were stored in the 
enumRange buffer) 
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retum(enumRangeTermBuf_CNT<=0?NULL: combine_tenns_array(eniimRangeTermBuf, 
enumRangeTermBuf_CNT, TRUE, randomize, NULL, FALSE)); 

} 

Static P4TERM get_var_types_term(int randomize) 

{ // return a term corresponding to the combined var-types (e.g. int(X); neq_vars(X,Y)) 
(which were stored in the VAR_TYPES buffer) 

retum(varTypesTermBuf_CNT<==0? NULL: combine_terms_array(varTypesTermBuf, 
varTypesTermBuf_CNT, TRUE, randomize, NULL, FALSE)); 

} 

static P4TERM pregoal_addenda_terms() 

{ // return terms (e.g. -BOUND< X < BOUND) to be added before the current goal 
P4TERM term, types_term, bound_term, prec_term; 
P4TERM exclude_solns_term, var_interval_term; 

term= types_term= get_var_types_term(FALSE); 

bound_term= NULL; // set_var_bounds_term(); «~ KNJ: remove it for now «— 
term= P4AND(term, bound_term); 

exclude_solns_term= RandomizeConstraints? get_exclude_solutions_term(TRUE): NULL; 
term= P4AND(term, exclude_solns_term); 
prec__term= vars_multiple_of_precision__term(); 
term= P4 AND (term, prec_term); 

var_interval_term= get_enum_ranges_term(RandomizeConstraints); 
term= P4AND(term, var_interval_term); 

retum(term); 

} 

static P4TERM postgoal_addenda_terms() 

{ // return terms (e.g. intspUt/1, func-terms) to be added after the current goal 
P4TERM term, funcjerm; 
//P4TERM splitjerm; 

term= func_term= buffered_func_terms(); 

// split_term= split__var_range_term(); // No need for splitting vars - and it may cause some 

overflow problems in VB 

// term= P4AND(term, splitjerm); 

retum(term); 

} 

static P4TERM append_func_defs(P4TERM term) 

{ // append (before/after the term ?) the function def s to the given term 
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// returns the appended term 
P4TERM t, func Jerm; 



func_term= buffered_func_terms(); 

t= P4AND(term, func_term); // for now, append the func_term AFTER the given 

term 

INIT_fiincTermBuf; // function-terms already consumed here - reset the 

functerms-buffer 

retum(t); 

} 

static P4TERM insert_func_defs(P4TERM var_defs, P4TERM expr_lst) 
{ // insert the function def s between the var_defs and expr__lst 

// returns P4AND(append_func_defs(var_defs), expr_lst) 
P4TERM term; 

term= append_func__defs(var_defs); 
term= P4AND(term, expr_lst); 

retum(term); 
} 

static BOOLEAN process_callJo jyrolog(P4TERM goal) 

{ // call Prolog IV with the given goal; return the result (i.e. TRUE/FALSE) of the call 
// sets the BOOLEAN var resultFromProIog4 to the result. 
P4TERM pregoal, postgoal; 

resultFromProlog4= 0; 
if (semError!= 0) 
retum(FALSE); 

if(!goal) 
retum(FALSE); 

if (pregoal= pregoal_addenda__terms()) // terms to add before goal 

goal = P4AND(pregoal, goal); 
if (postgoal= postgoal_addenda_terms()) // terms to add after goal 

goal = P4AND(goal, postgoal); 

/* ~ P4 setof/3 & bagof/3 are buggy - hence we simulate them ourselves 
if(doBufferSoln) 

{ // call setof/3 - buffer (& order) all the solutions, return the result of call 
retum(resultFromProlog4= fmd_setof_soln(goal)); 

} 
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else 

*/ 



P4MAKE_CALL(goal); 
resultFromProlog4= p4next_solution(); 

/* -- Prints message incorrectly on time-limit-forced abortion 
if(resultFromProlog4=P4SESSION_ERROR) 

{printf("\n***Encountered error in process_call_to_prolog(), ermo: %d***\n", 
p4ermo) ; fflush(stdout) ; } 

*/ 

retum(resultFromProlog4== P4SESSI0N_S0LUTI0N); 
} 

static P4TERJvl combine_terms_array(P4TERM terms[], long size_terms, int do_conjunct, int 
randomize, P4TERM var, int var_eq) 

{// returns a combined terms for the elements (or, if var is non-NULL: var= Element (if var_eq is 
TRUE) (or, if var_eq is FALSE, var =/= Element)) from the given array of terms : 

// use conjunct to combine terms if do_conjunct is TRUE, disjunct 

otherwise; 

// (randomize the array before combining if randomize is TRUE.) 

// (note that it shuffles the terms, when randomizing, in the given terms-buffer itself) 

int i; 

P4TERM t, cmbnd Jerm; 

#defme MAX_SHUFFLE (5 1 ) 

if (size_terms<= 0) 

retum(NULL); 
if (size_terms=l ) 

retum(terms[0]); 

if (randomize) 

{ 

int X, y, max_shuffle; 
P4TERM tmp; 

// graduated scale for max-shuffling 
max_shuffle= (size_terms<= 10)? 3* size_terms: 

(size_terms<= 20)? 2* size_terms+ 

10: 

MAX^SHUFFLE; 

for(i= 0; i< max_shuffle; i++) 

{ // shuffle the terms in the terms-buffer 
x^ random()% size_terms; 
y== random()% size_terms; 
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tmp= tenns[x]; 
tenns[x]= terms[y]; 
terms [y]^ tmp; 
} 

} 

for(cmbnd_term= NULL, i= 0; i< size_terms; i++) 

{ 

t= !var? terms[i]: var_eq? P4EQ(var, terms[i]): P4NEQ(var, terms[i]); 
cmbnd_term= do_conjunct? P4AND(cmbnd_term, t): P40R(cmbnd_temi, t); 

} 

retum(cmbnd_temi) ; 

} 

static P4TERM combine_terms_list(List *terms_lst, int do_conjunct, int randomize, P4TERM 
var, int var_eq) 

{// returns a combined tenns for the elements (or, if var is non-NULL: var^ Element (if var_eq 
TRUE) (or, if var_eq is FALSE, var =/= Element)) from the given list of terms : 

// use conjunct to combine terms if do_conjunct is TRUE, disjunct 

otherwise; 

// (randomize the array before combining if randomize is TRUE.) 
P4TERM t, cmbndjerm; 

if (! randomize) 

{ 

for(cmbnd_tenn= NULL; terms_lst; terms_lst= terms_lst->next) 

{ 

t= !var? terms_lst->elem: var_eq? P4EQ(var, terms_lst->elem): P4NEQ(var, 
terms_lst->elem); 

cmbnd_term^ do_conjunct? P4AND(cmbnd_term, t): P40R(cmbnd_term, t); 

} 

} 

else 

{ // put the list-terms in an array, call combine_terms_array() with the array 
P4TERM *terms; 
List *lst; 
int i; 

for(i= 0, lst= terms_lst; 1st; lst= lst->next, i++); 
if (!(terms= calloc(i, sizeof(P4TERM)))) 

{ 

printf("\n***Unable to calloc P4TERM-array in 
combine_terms_list()* * *\n") ;fflush(stdout); 

retum(NULL); // return NULL on error 

} 
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for(i= 0, lst= terms_lst; 1st; lst== lst->next, i++) 
terms lst->elem; 

cmbnd_term= combine_terms_array(terms, i, do__conjunct, randomize, var, var_eq); 
free(tenns); 

} 

retum(cmbnd__term) ; 

static char *map_func_name(char *given_func_name) 

// check if the given function-name needs to be mapped e.g. gcd -> gcdtemp 
// return the properly mapped function name 

{ 

int i; 

for(i= 0; FuncRenanieList[i].func_name && strcmp(given_func_name, 
FuncRenameList[i] .func_name); i++); 

retum(FuncRenameList[i].func_name? FuncRenameList[i].map_to_name: given_func_name) 

} 

static P4TERM unop_term(int op, P4TERM term) 

{ // make unary op term for standard op's, return the result term (e.g. "- X" => "uminus(Res, 
X)", return Res). 

// (Note: This function can handle only the ProloglV-standard unary operators; use 
make_functor() for nonstandard operators (e.g. abs, factorial) ) 
char *func; 
P4TERM res; 

if(!term) 
{ 

semErroi= ERR_NULL_TERM; 

retum(NULL); 

} 

switch(op) 

{ // at some point, we need to decide between approx. & exact solvers (e.g. uminuslin vs 
uminus) 

case func= uselntervalSolver? break; 
case'+': func= uselntervalSolver? ".+.": "+"; break; 
default: retum(NULL); 

} 

func= map_func_name(func); 

if (!(res= P4MAKE_FUNC_l(func, term))) 

{ 

semError= ERR_MAKING_FUNCTOR; 
retum(NULL); 



PROLOG SCA -70- 



) 

retum(res); 

} 

static P4TERM binop_arith_term(P4TERM terml, int op, P4TERM term2) 

{ // make binary op term for standard arithmetic op's, return the result term (e.g. " X + Y" => 

"plus(Res, X, Y)". 

// Returns (ptr to the term representing) the result of the computation rather than the 
Boolean status of the call. 

// Note that these are called using arity 3 Prolog IV predicates. 
// (Note: This function can handle only the ProloglV-standard binary operators; use 
make_functor() for nonstandard operators (e.g. mod, div) ) 
char *func; 
P4TERM res; 

if (!terml || !temi2) 
{ 

semError= ERR_NULL_TERM; 

retum(NULL); 

} 

switch(op) 

{ // at some point, we need to decide between approx. & exact solvers (e.g. minuslin vs minus) 

case'+': func= uselntervalSolver? ".+.": "+"; break; 

case'-': func= uselntervalSolver? ".-.": "-"; break; 

case'*': func= uselntervalSolver? ".*.": "*"; break; 

case'/': func= uselntervalSolver? "./.": "/"; break; 

case '%': func= "mod"; break; 

case 'W: func= "intdiv"; break; 

case "^': func= ".'^."; break; // power/2 

//case'-': func="~"; break; 

default: retum(NULL); 

} 

func= map_func_name(func); 

if (!(res= P4MAKE_FUNC_2(func, terml, term2))) 

{ 

semError= ERR_MAKING_FUNCTOR; 

retum(NULL); 

} 

retum(res); 

} 

static P4TERM binop_bool_term(P4TERM terml, int op, P4TERM term2) 

{ // make binary op term for standard boolean op's (e.g. " X, Y" => "and(X, Y)". 

char *func; 
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P4TERM res; 



if (Iterml || !term2) 
{ 

semError= ERR_NULL_TERM; 

retura(NULL); 

} 

switch(op) 

{ // at some point, we need to decide between approx. & exact solvers (e.g. minuslin vs minus) 
caseEQ: func= "="; break; 
case NEQ: func= "dif '; break; 

case func= ","; break; // note that ,/2 is different from aiid/2 in Prolog IV 

case ';': func= ";"; break; // note that ;/2 is different from or/2 in Prolog IV 

caseLT: func=useIntervalSolver? "It": "Itlin"; break; 

case LE: func= uselntervalSolver? "le": "lelin"; break; 

caseGT: func= uselntervalSolver? "gt": "gtlin"; break; 

case GE: fimc= uselntervalSolver? "ge": "gelin"; break; 

default: retum(NULL); 

} 

func= map_func_name(func); 

if (!(res- P4MAKE_FUNC_2(ftinc, terml, term2))) 

{ 

semError= ERR_MAKING_FUNCTOR; 

retum(NULL); 

} 

retum(res); 

} 

static P4TERM make_termlist2term(List *lst) 

{ // convert the given list of P4-terms to Prolog IV list-term 

// recursive implementation to maintain the order of elem's 
// free the given list ?? 

retum(lst? check_term(p4make_dot((P4TERM) lst->elem, make_termUst2term(lst->next))): 

check_term(p4make_nil())); 

} 

static P4TERM make_valslist2term(List *lst) 

{ // convert the given hst of Values to Prolog IV hst-term 

// recursive implementation to maintain the order of elem's 
retum(lst? checkJerm(p4make_dot(get_value_term(lst->elem), make_valslist2term(lst->next))) : 
checkjerm(p4make_nil())); 
} 

static P4TERM make_int_rel(List *lst) 
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{ // make (& return) a conjunct of int/1 terms (e.g. int(X), int(Y)) for the given list 
P4TERM t, term; 

for(term= NULL; 1st; lst= lst->next) 
{ 

t= P4MAKE_FlJNC_l("int", (P4TERM) lst->elem); 
term= P4AND(term, t); 
} 

// add the actual int_rel-term to the VAR_TYPES buffer - so we can later manipulate it 
if (term) 

ADD_VAR_TYPES_TERM(tenn); 

// return just a placeholder since we already added the int_rel-term to the buffer 
retum(P4TRUE); 

} 

static P4TERM make_real_rel(List *lst) 

{ // make (& return) a conjunct of real/1 terms (e.g. real(X), real(Y)) for the given list 
P4TERM t, term; 

for(term= NULL; 1st; lst= lst->next) 
{ 

t= P4MAKE_FUNC_l("real", (P4TERM) lst->elem); 
term= P4AND(term, t); 

} 

// add the actual real_rel-term to the VAR_TYPES buffer - so we can later manipulate it 
if (term) 

ADD_VAR_TYPES_TERM(term); 

// return just a placeholder since we already added the real_rel-term to the buffer 
retum(P4TRUE); 

} 

static P4TERM make_rational_rel(List *lst) 

{ // make (& return) a conjunct of real/1 & rational/1 terms (e.g. real(X), rational(X)) for the 
given list 
P4TERM t, term; 

for(term= NULL; 1st; lst= lst->next) 
{ 

t= P4MAKE_FUNC_l("rational", (P4TERM) lst->elem); 
term= P4AND(term, t); 
} 
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// add the actual real rel-term to the VAR_TYPES buffer - so we can later manipulate it 
if (term) 

ADD_VAR_TYPES_TERM(term); 

// return just a placeholder since we already added the real_rel-term to the buffer 

retum(P4TRUE); 

} 

static P4TERM make_neqvars_rel(List *varslist) 

{ // make a term to enforce all var's in the Hst are different from each other; 

// put that term in VARS_TYPE_BUF for later use; return P4TRUE for now at end 
P4TERM t, term; 
List*listl,*list2; 

term= NULL; 

for(listl= varslist; listl; listl= Ustl->next) 

for(list2= listl ->next; list2; list2= list2->next) 
{ 

if (Ustl->elem && list2->elem) 
{ 

t= P4NEQ((P4TERM)listl->elem, (P4TERM)list2->elem); 
term= P4AND(term, t); 

} 

} 

// add the actual neqvars-term to the VAR_TYPES buffer - so we can later manipulate it 
if (term) 

ADD_VAR_TYPES_TERM(term); 

// return just a placeholder since we already added the neqvars-term to the buffer 

retum(P4TRUE); 

} 

static P4TERM make_eqvars_rel(List *varslist) 

{ // make a term to enforce all var's in the list are equal to each other; 

// put that term in VARS_TYPE_BIJF for later use; return P4TRUE for now at end 
P4TERM t, term; 
List *hstl, *list2; 

term= NULL; 

for(hstl= varslist; listl; listl= hstl->next) 

for(Hst2= listl->next; list2; list2= list2->next) 

{ 

if (Ustl->elem && hst2->elem) 
{ 
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t= P4EQ((P4TERM)listl->elem, (P4TERM)list2->elem); 
term= P4AND(term, t); 

} 

} 

// add the actual eqvars-term to the VAR_TYPES buffer - so we can later manipulate it 
if (term) 

ADD_VAR_TYPES_TERM(term); 

// return just a placeholder since we already added the eqvars-term to the buffer 
retum(P4TRUE); 

} 

static P4TERM make_neqvarvals_rel(P4TERM var, List *valslist) 

I // make a term to specify that the given var is not equal to any of the given values in the 
valsHst; 

// put that term in VARS_TYPE_BUF for later use; return P4TRUE for now at end 
P4TERM t, term; 
List *Hstl; 

if (!var || Ivalshst) 

retum(P4TRUE); 

term= NULL; 

for(listl= valsUst; listl; Ustl= listl->next) 
{ 

t= P4NEQ(var, (P4TERM)listl->elem); 

term= P4AND(term, t); 

} 

// add the actual eqvars-term to the VAR TYPES buffer - so we can later manipulate it 
if (term) 

ADD_VAR_TYPES_TERM(term); 

// return just a placeholder since we already added the eqvars-term to the buffer 
retum(P4TRUE); 

} 

static P4TERM make_optimizable_rel(P4TERM rel) 

{ // optimize the given rel-term (for now, we just put it at the start of the clauses); 

// put that term in VARS_TYPE_BUF for later use; return P4TRUE for now at end 

if(!rel) 

retum(P4TRUE); 

// add the actual term to the VAR_TYPES buffer - so we can later manipulate it 
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ADD_VAR_TYPES_TERM(rel); 

// return just a placeholder since we already added the term to the buffer 
retum(P4TRUE); 

} 

static P4TERM make_inlist(P4TERM var, List *lst) 

{ // make (& return) (var inlist 1st) constraint; (1st is list of P4 terms.); 

// (Obsolete: the translation uses inlist/1 e.g. "X in [a, b, 5]" => "X ~ inUst([a, b, 5])". 

// that approach provoked many problems in relations which expected 

constants e.g. gcd/2.) 

// Obsolete: retum(P4MAKE_FUNC_2("inhst", var, make_termlist2term(lst))); 

// The current translation essentially uses disjunction e.g. "X in [a, b, 5]." => (X= a; X= b; 

X= 5)." 

retum(P4MAKE_FUNC_2("one_of' , var, makejermlist2term(lst))); 

] 

static P4TERM make_fi-omlist(P4TERM var. List *lst) 

{ // make (& return) (var inlist 1st) constraint; (1st is list of P4 terms.); 

// some modifications/optimizations are made for randomization 

// mark the given var as an independent variable 
TabElem *p_tab_elem; 
P4TERM term; 

if (!(p_tab_elem= get_term_tabelem(var))) 
retum(NULL); 

p_tab_elem->is_independent_var = TRUE; // all enumerated var's are considered 

independent 

term= P4MAKE_FUNC_2("random", var, make_termhst2term(lst)); 
// add the actual term to the enumRangeTerm buffer - 

// so we can later randomize it (to help produce different-looking solutions) 

ADD_ENUM_RANGE_TERM(term); 

// return just a placeholder since we already added the enumRange term to the buffer 
retum(P4TRUE); 

} 

static P4TERM make_notinlist(P4TERM var, List *lst) 

{ // make (& return) (var notinlist 1st) constraint; (1st is list of P4 terms.); 

// ?? should we try the conjunction e.g. "X notin [a, b, 5]." => (X=/= a, X=/= b. X=/= 5)." 

??? 
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retum(P4MAKE_FUNC_2("outlist", var, make_termlist2tenn(lst))); 
} 

static P4TERM make_interval(P4TERM left, int left_rel, P4TERM var, int right_rel, P4TERM 
right) 

{ // make (& return) interval constraint e.g. "4.5 < X <= 9" => "oc(X, 4.5, 9)"; "4.6 >= X 
2" => "oc(X, 2, 4.6)" 

// Note that this is different from an enumeration over an interval, 
char pred_name[3]; 
P4TERM term; 

if (!var II ((lefl_rel==LE || left_rel==LT) && (right_rel=GE || right_rel==GT)) || 

((left_rel==GE |1 left_rel=GT) && (right_rel=LE || right_rel-=LT))) 
{ // e.g. "4.5 < X > 7.5" 
semError= ERR_INVALID_INTERVAL; 
retum(NULL); 

// build the predicate name from the given relationships 
pred_name[0]= (left_rel=LE || left_rel==GE)? 'c':'o'; 
pred_name[l]= (right_rel==LE || right_rel=GE)? 'c':'o'; 
pred_name[2]= 0; 

term= P4MAKE_FUNC_3(pred_name, var, left, right); 

#ifdef WANT_ALL_SMALL_SOLUTIONS 

// while this ok to do (and gives good solutions), it leads to unnecessary 
undesirably small solutions in large quantity 

// — For now, don't use it — 
if (uselntervalSolver) 

{ // spUt the bovmded var when using interval-solver 

char *split_pred; 

P4TERM t, Istjerm; 

TabElem *p_tab_elem; 

if (!(p_tab_elem= get_term_tabelem(var))) 
retum(NULL); 

split _pred= (p_tab_elem->type= VAL_INTEGER)? "intsplit": "realsplit"; 
lst_term= p4make_dot(var, p4make_ml0); // X -> [X] 
t= P4MAKE_FUNC_3(split_pred, IstJerm, 
p4make_atom_from_cstring("smallest_domain"), P4Make_Rational(p_tab_elem->precision)); 
term= P4AKD(term, t); 
} 

#endif /* WANT_ALL_SMALL_SOLUTIONS */ 



retum(term); 
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} 

static P4TERM make_enumeration(P4TERM left, int left_rel, P4TERM var, int right_rel, 
P4TERM right, P4TERM step) 

{ // make (& return) enumeration constraint e.g. "[4.5 < X 8 step 1]" => "(X=4.5; 
X=5.5; X= 6.5; X= 7.5)" 

// Note that this is different from interval, 
char *pred_name; 
TabElem *p_tab_elem; 
P4TERM term, adjjeft, adj_right; 

if (!var || !step || ((left_rel==LE || left_rel==LT) && (right_rel==GE |1 right_rel==GT)) || 
((left_rel=GE || left_rel==GT) && (right_rel=LE || right_rel==LT))) 
{ // e.g. "4.5 < X > 7.5" 
semError= ERR_INVALID_INTERVAL; 
retum(NULL); 
} 

if (!(p_tab_elem= get_term_tabelem(var))) 
retum(NULL); 

p_tab_elem->is_independent_var = TRUE; // all enumerated var's are considered 

independent 

// Note: we don't care here which is min or max value - envmierate/4 takes care of that. 
pred_name= enumerateVarsRandomlyNoHistory? "enumerate random": "enumerate"; 
if (p_tab_elem->type== VAL_INTEGER) 

pred_name= enumerateVarsRandomlyNoHistory? 
" enumerate_int_random" : "enumerate_int" ; 

adj_left= (left_rel==LT)? P4MAKE_FUNC_2("+", left, 
check_term(P4Make_Rational(p_tab_elem->precision))): 

(left_rel=GT)? P4MAKE_FUNC_2("-", left, 
check_term(P4Make_Rational(p_tab_elem->precision))): 

left; 

adj_right=(right_rel==LT)? P4MAKE_FUNC_2("+", right, 
check_term(P4Make_Rational(p_tab_elem->precision))): 

(right_rel=GT)? P4MAKE_FUNC_2("-", right, 
check_term(P4Make_Rational(p_tab_elem->precision))): 

right; 

term= P4MAKE_FUNC_4(pred_name, var, adj left, adj right, step); 

// add the actual enumerated-range term to the enumRangeTerm buffer - 

// so we can later randomize it (to help produce different-looking solutions) 

ADD_ENUM_RANGE_TERM(term); 

// return just a placeholder since we already added the enumRange term to the buffer 



PROLOG SCA -78- 



retum(P4TRUE); 

} 

static P4TERM make_exterval(P4TERM left, int left_rel, P4TERM var, int right_rel, P4TERM 
right) 

{ // make (& return) exterval constraint e.g. not("4.5 < X <= 9") => "outoc(X, 4.5, 9)"; not("4.6 
>= X > 2)" => "outoc(X, 2, 4.6)" 
char pred_name[6]; 

if (!var II ((left_rel=LE |1 left_rel=LT) && (right_reI=GE || right_rel=GT)) 1| 
((left_rel=GE || left_rel=GT) && (right_rel==LE || right_rel=LT))) 
{ // e.g. "4.5 < X > 7.5" 
semError= ERR_INVALID_INTERVAL; 
retum(NULL); 
} 

strcpy(pred_name, "out"); 

pred_name[3]= (left_rel==LE || left_rel=-GE)? 'c':'o'; 
pred_name[4]= (right_rel==LE || right_rel=GE)? 'cVo'; 
pred_name[5]= 0; 

retum(P4MAKE_FUNC_3(pred_name, var, left, right)); 

} 

static P4TERM make_functor(char *pred_name, List *arg_lst) 

{ // make & return ProloglV functor for the given predicate/args (e.g. given "mean", [X, Y] 
for "mean(X, Y)") 

// We allow no user-relations - only user-functions. 

// As such, we add 1 result var (at the leftmost position) to all the user- functions. 
// free the given Hst after use ?? 
int i, cnt, arity; 

P4TERM terms[MAX_ARITY+l], anon_resuh, funcjerm; 
List *lst; 

anon_result= NULL; 
cnt= 0; 

arity= argjst? arg_lst->elem_cnt: 0; 
if (arity >MAX_ARITY) 

{ 

semError= ERR_ARITY_TOO_MANY; 
retum(NULL); 

// convert given func/n to rel/n+1 e.g. X= mean(X, Y) -> X= _R, meanC_R, X, Y). 
terms[cnt++]= anon_result= check_term(p4make_var()); 
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for(i- 0, lst= argjst; i< MAX_ARITY && 1st; 1st- lst->next,i++) 
terms[cnt++]= (P4TERM)lst->elem; 

pred_name=== map_func__name(pred__name); 

func_tenn= check_term(p4vmake_functor(cnt, p4str2symbol(pred_name), terms)); 
ADD_funcTermBuf(func_term); // add func Jerm to funcTemiBuf so we can generate code 
at end for it 
retum(anon_result) ; 

} 

static P4TERM indexed_list_element(P4TERM list. List *index_lst) 

{ // return ProloglV term for the given list-indexed-term (e.g. L[ 1 , 2]) 

// Translation scheme: List[I, J, K] => nth(K, nth(J, nth(I, List))). 
P4TERM nth_elem, funcjerm; 

if (! list II lindexjst) 

retum(NULL); 

nth_elem= check_term(p4make_var()) ; 

func_term= P4MAKE_FUNC_3("nth", nth_elem, index_lst->elem, list); 
ADD_funcTermBuf(fiinc_term); // add funcjerm to funcTermBuf so we can generate code 
at end for it 

retum(index_lst->next? indexed Jist_element(nth_elem, index_lst->next): nth elem); 
} 

static P4TERM if_then_else(P4TERM cond, P4TERM thenjerm, P4TERM elsejerm) 
{ // make & return ProloglV term for the given if-then-else construct 

// This is a backtrack-less-implementation of if-then-else. 

// if C then T else E => (C, T, !); E. 

retum(else_term? P4IF_THEN_ELSE(cond, thenjerm, elsejerm): P4IF_THEN(cond, 
thenjerm)); 

} 

static P4TERM ifJhen_elseif(P4TERM then_cond, P4TERM thenjerm, P4TERM else_cond, 
P4TERM elsejerm) 

{ // make & return ProloglV term for the guarded-if if-then-elseif construct 
// if TC then T elseif EC E => (TC, T); (EC, E). 

retum(P4IF_THEN_ELSEIF(then_cond, thenjerm, else_cond, elsejerm)); 

} 



PROLOG SCA -80- 



%} 



%union 

{ 

int ival; 
float fval; 
double dval; 
char * string; 
List *list; 
P4TERM term; 

} 

%token <ival> INTNUM NOTIN_SET IN_SET FROM_SET NOT PI 

%token <ival> INT_PRED REAL_PRED RATIONAL_PRED 

FRACTION PRED LIST PRED FREEZE 



%token <ival> 
END_VAR_DEFS STEP 
%token <ival> 
OPTIMIZABLEREL PRED 



%token 
%token 
%token 
%token 
%token 
%token 
%token 
%token 



<ival> 

<string> 

<ival> 

<ival> 

<ival> 

<ival> 

<ival> 

<ival> 



IF THEN ELSE ELSEIF SUCCEED FAIL SYMBOL_PRED 

EQVARS_PRED NEQVARS_PRED NEQVARVALS_PRED 

ONGRID_PRED OFFGRID_PRED 

REALNUM ATOM_CONST VAR 

GTLT 

GE ">=" 

LE "<=" 

EQ "==" 

NEQ "=/=" 

EXRANGE START "[!" 



%left 
%left 

%nonassoc 
%nonassoc 
%left 

%nonassoc 

%left 

%left 

%left 

%left 

%nonassoc 

%left 

%left 



tjt 

7' 

'%• 'W 
NEG 

'Af 



<= 



%type <term> prolog_expr expr exprjst rel_expr range_expr typejist type_symbol 

%type <term> rel_expr arith_expr function pjist typejnt type_real type_rational type_fraction 

%type <term> constant num_constant atom var if_then_else flow_expr type__expr base_expr 
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%type <term> index type_eqvars type_neqvars type_neqvarvals type_optimizablerel 

%type <term> type ongrid type_offgrid 

%type <ival> rel_op_lege 

%type<dval> number 

%type <list> list var_lst constant_lst 



10 



%% 



prolog_expr : expr_lst '.' {$$- 
(P4TERM)process_call_to_prolog($ 1 );} 

I exprjst EM)_VAR_DEFS ',' exprjst '.' 
{$$= (P4TERM)process_call_to_prolog(insert_func_defs($l, $5));} 

I error 

{$$=NULL; } 



15 exprjst: exprjst ',' exprjst {$S= P4AND($1, $3);} 

I exprjst ';' exprjst {$$= P40R($ 1 , $3);} 

I expr 



§1 expr :'(' expr_lst ')' 
2Qi I base_expr 

1: {$$= append func_defs($l);} 



{$$= $2;} 



2Sf 



base_expr: rel_expr 



range_expr 

flow_expr 

type_expr 



30 



flow_expr 
P4CUT;} 
P4TRUE;} 
P4FAIL;} 



ifjhenelse 
I FREEZE 

I SUCCEED 

I FAIL 



{$$-- 
{$$- 
{$$-- 



35 



type_expr 



typejnt 

I type_real 
I type_rational 
I type_fraction 
I typejist 
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type_symbol 

typeongrid 

typeoffgrid 

type_eqvars 

type_neqvars 

type_neqvarvals 

type_optimizablerel 



if_then_else: IF expr THEN expr ELSE expr {$$= if_then_else($2, $4, $6);} 

I IF expr THEN expr ELSEIF expr THEN expr {$S= 

if_then_elseif($2, $4, $6, $8);} 

I IF expr THEN expr 

{$$= if_then_else($2, $4, NULL);} 



typejnt : INT_PRED varjst ')' {mark_term_list_type($2, 
VAL_INTEGER); $$= make_int_rel($2);} 

type real : REAL_PRED varjst ')' {mark_term_list_type($2, 
VAL_RATIONAL_FLOAT); $$= make_real_rel($2);} 

type_rational : RATIONAL_PRED varjst ')' {markjennjistjype($2, 
VAL_RATIONAL_FLOAT); $$= make_rational_rel($2);} 

type_fraction: FRACTION_PRED varjst ')' {mark term_Iist type($2, 

VAL_RATIONAL_FRACTION); $$= make_real_rel($2);} 

typejist : LIST_PRED varjst ')' {$$=P4TRUE; 
markjerm_listjype($2, VAL_LIST);} 

type_symbol : SYMBOL_PRED varjst ')' {$$=P4TRUE; 
markjennjistjype($2, VAL SYMBOL);} 

type_ongrid: ONGRID_PRED var ')' {$$=P4TRUE; 
set Jerm_on_grid($2); } 

type_offgrid: OFFGRID PRED var ')' {$$=P4TRUE; 
reset Jenn_on_grid($2); } 



type_eqvars : EQVARS_PRED var Jst ')' {$$= make_eqvars_rel($2);} 

5 

type_neqvars: NEQVARS_PRED var Jst ')' {$$= make_neqvars_rel($2);} 
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type_neqvarvals: NEQVARVALS_PRED var '/ list ')' 
make_neqvarvals_rel($2, $4);} 

type_optimizablereI: OPTIMIZABLEREL_PRED rel_expr ')' 
make_optimizable_rel(S2);} 



{$$= 



{$$= 



rel_expr : arith_expr '<' arith_expr {$$=binop_bool_term($l, LT, $3);} 



I arith_expr '>' arith_expr 
binop_bool_term($l, GT, $3);} 

I arith_expr arith_expr 

EQ, $3);} 

I arith_expr "=/=" arith_expr 

NEQ, $3);} 

I arith_expr arith_expr 
binop_bool_term($l, EQ, $3);} 

I arith_expr ">=" arith_expr 

GE, $3);} 

I arith_expr "<=" arith_expr 

LE, $3);} 

I •(' rel_expr ')' 

$2;} 

I NOT rel_expr 
{$$= P4NOT($2);} 
/* I function 

may not have relations */ 



{$$= binop_bool_term($l, 
{$$= binop_boolJerm($l, 
{$$= 

{$$= binop_bool Jerm($l , 
{$$= binop_bool_temi($l , 
{$$= 

{$$=$1;} - 



range_expr 



arith_expr ']' 



$4);} 



'[' arith expr rel_op_lege var rel_op_lege arith expr ']' 

{$$= make_interval($2, $3, $4, $5, $6);} 
I "[!" arith_expr rel_op_lege var rel_op_lege arith_expr ']' 

{$$= make_exterval($2, $3, $4, $5, $6);} 
I '[' arith expr rel_op_lege var rel opjege arith_expr STEP 



{$$= make_enumeration($2, $3, S4, $5, $6, $8);} 
var FRO]V[_SET '[' list ']' {$$= make_fromlist($l , 

var IN_SET '[' Hst ']' {$$= make_inUst($l , S4);} 

var NOTIN_SET '[' list ']' {$$= make_notinlist($l , $4);} 



rel_op_lege 
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{$$= LT;} 



{$$-LE;} 
'>' 

{$$= GT;} 

";>=" 

{$$= GE;} 



pjist: '['list']' {$S= 
make_termlist2term($2); } 



list : list '; arith_expr {$$= ncons($l, (void *)$3);} 

I arith_expr 
{$$= list((void *)$1);} 



arith_expr : arith expr '+' arith_expr {$$=binop_arith_term($l, '+', $3);} 

I arith_expr '-' arith_expr {$$= 
binop_arith_term($l, '-', $3);} 

I arith_expr '/' arith_expr {$S= 
binop_arith_term($l, '/', S3);} 

I arith_expr '*' arith expr {$$= 
binop_arith_term($l, '*', $3);} 

I arith_expr arith_expr {$$= 
binop_arith_tenn($l, '^', $3);} 

I arith_expr '%' arith_expr {$$= 
make_functor("mod", cons((void *)$1, list((void *)$3)));} 

I arith_expr 'W arith_expr {$$= 
make_functor("intdiv", cons((void *)$1, list((void *)$3)));} 

I '-' arith_expr %precNEG {$$= unop_term('-', 

$2);} 

I arith_expr'!' 
{$$= make_functor("factorial", list((void *)$!));} 

! 'I' arith_expr '|' {$$= 
make functorC'abs", list((void *)$2));} 

I '(' arith_expr ')' 

{$$= $2;} 

1 function 

{$$=$1;} 

I index 

{$$=$1;} 

I P_list 

{$$=$1;} 
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constant 



{$$=$1;} 



var 



{$$=$1;} 



function : ATOM_CONST '(' list ')' 

I ATOM_CONST '(' ')' 
{$$= make_functor($l, NULL);} 



{$$= make_functor($l, $3);} 



index : var '[' list ']' 
indexed_list_elenient($l, $3);} 



{$$= 



var_lst : var_lst ',' var 

ncons($l, (void *)$3);} 

I var 



{$$= 



{$$= list((void *)$1);} 



constant_lst: constant_lst V constant 
I constant 



{$$=ncons($l, (void *)$3);} 
{$$= list((void *)$1);} 



constant 



num_constant 
I atom 



num_constant: INTNUM {Value val; S$= 

check_term(p4make_lint($l)); val.type= VAL_INTEGER; val.value.integer= $1; 

insert_const(S$, &val);} 

I REALNUM {Value val; 

$$= check_term(p4make_rational($l)); /* yylex passes string in yylval */ val.type= 
VAL_RATIONAL_FLOAT; val.value.rational.real= atof($l); insert_const($$, &val);} 

I PI {Value 
val; $$= checkJerm(P4Make_Rational(PI_VAL)); val.type= VAL RATIONAL FLOAT; 
val.value.rational.real= PI_VAL; insert_const($$, &val);} 



atom : ATOM_CONST 
check_term(p4make_atom_from_cstring($l));} 



{$$= 
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var : VAR 

{$$=insert_var($l);} 
I '{' VAR V number'}' {S$= 

insert_var_with_precision($2, $4);} 

I '{'VAR',' number '/'number'}' {$$= 

insert_var_with_precision($2, ((double)$4)/$6);} 



number: INTNUM {$$- (double)$l;} 

I REALNUM {$$= 

(double)atof($l); /* yylex passes string in yylval */} 

I PI {$$= 

(double)PI_VAL;} 



%% 

static int restart_parser() 
{ 

yyclearin; 
retum(l); 

} 

Static int restart_lexer() 
{ 

extern void yyrestart(FILE *); 

yyrestart(NULL); 
retum(l); 

} 

static BOOLEAN init_solve_constraint(int keep_solns) 

{ // initialize all the buffers; if keep_solns is true, do not initialize the solns (& value) buffers 

// returns true if ok, false in error 
if (! StartProlog4Session(NULL)) 

retum(FALSE); 
// initialize various data structures 
if (!keep_solns) 

{ 

INIT_valBuf; 
INIT_solnBuf; 

} 

INITjnExprBuf; 

rNIT_vars; 

MTJuncTermBuf; 
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INIT_anonVarBuf; 
INIT_constBuf; 
INIT_enumRangeTermBuf; 
INIT_varTypesTermBuf; 

// initilize parser/lexer states & data structures (if any) ... 
restart_lexer(); 
restart__parser(); 

retum(TRUE); 
} 

int yyerror(char '^s) 

{ // handle error 

// printf(" syntax errorVn"); 

semError= ERR_PARSE; 

retum(O); 

} 

// some augmented functions for Prolog IV API - some of them may go away as we get 
newer, better API 

static P4SYMB0L p4str2symbol(char *str) // pseudo p4-routine 

{ // convert the given atomic (i.e. starting with lowercase e.g. 'aTom') string to Prolog IV symbol 

P4SYMB0L sym; 

if (p4cstring__to_symbol(str, &sym)) 

{ 

semError= ERR_GETTING_TERM; 

retum(O); 

} 

retum(sym); 

} 

static P4TERM p4make_atom_from_cstring(char *str) // pseudo p4-routine 

{ // convert the given atomic (i.e. starting with lowercase e.g. 'aTom') C-string to Prolog IV 

atomic term 

P4SYMB0L sym; 

if (p4cstring_to_symbol(str, &sym)) 

{ 

semError= ERR_GETTING_TERM; 
retum(NULL); 

} 

retum(p4make_atom(sym)); 

} 

static int p4is_constant(P4TERM term) // pseudo p4-routine 
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{ // returns TRUE if the given term is constant 
int type; 

type= P4WHAT_IS(term); 

retum(!(type--P4NULL || type==P4N0TATERM 1| type= P4VAR || type= 
P4UNEXPECTEDTERM)); 

} 

static P4TERM P4Make_Rational(double val) // pseudo p4-routine 

{ // KNJ: make (& return) term for the given double (rational) value 

charbuf[256]; 

sprintf(buf, "%.6f' , val); // maximum precision is limited to 6 positions 
retum(make_rational_strfloat(buf)); 

} 

static P4TERM p4make_rational(char *floatstring) 

{ // by Pascal Bouvier (of Prologianet): Build a positive rational number from a C-string 
containing its decimal 

//representation (e.g. "4.5", "LOOOOOOOOO", "24.02el997", ...) 
char buf[256]; 

strcpy(buf, floatstring); 
retum(make__rational__str float(buf)) ; 

} 

static double p4val_as_double(P4TERM T) 

{ // by Pascal Bouvier (of Prologianet):Given a numeric Term, converts it as a double (with 
probable loss of precision) 
switch (P4WHAT_IS(T)) 

{ 

case P4INTEGER: case P4RATI0NAL; 

retum(nearest_ip_fpd(dereference(T))); 

default: 

retum(-l 1 1 11 .1 11); /* in error */ 

} 

} 

static char *p4_symbol_to_cstring(P4 SYMBOL symbol) 

{ // by Pascal Bouvier (of Prologianet): return the c-string rep. of the symbol 

retum(symbol_shortidP(symbol)); 

} 
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' hlP4API.h 

/* 

* hlP4API.h: Specification of high level API to Prolog IV 

* 

#include <windows.h> // necessary for VB stuff e.g. BSTR 

// The stdcall calling-convention is used for compatibility with VB 
#defme CCONV _stdcall 

#define DEF_PRECISION (0,01) 
#defme DEF_SOLN_DIFF_WT (1) 
#define DEF_FLOAT_INTERVAL_STEP (0.1) 
#define DEF_INTEGER_INTERVAL_STEP (1) 
#define DEF_UPPER_BOUND (64000) 
#define DEF_LOWER_BOUND (-64000) 
1 5 #define DEF_GRID (TRUE) 

j'; typedef struct s_list 
{ // ordered Ust 

:li short elem__cnt; // total no. of elements (including this element) in the list 
4 : void *elem; // this element (type to be inferred from the context) 

24^ struct s_list '^'next; 
} List; 

typedef struct s_functor 

{ II structure to represent a Prolog IV functor (e.g. member/2) in C 
'% char ^predicate; 
25^ int arity; 
r- : } Functor; 

typedef struct s_rational 

{ // structure to represent a rational number 
double real; // real representation of a rational e.g. "4.5" 
30 long num; // numerator from A/B rep. of rational e.g. 9 from 9/2 

long den; // denominator from A/B rep, of rational e.g. 2 from 9/2 

} Rational; 

typedef struct s_bound // a bound for non-rational real 

{ 

35 char isjnfmite; // flag - true if the real-val is infinite 

double val; // value of the non-infinite real 

} Bound; 
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// representation (bound) for non-rational real 



// type of the result (e.g. VAL_INTEGER, VAL_LIST) 



typedef struct s_real 

{ 

Bound lower, upper; 
} Real; 

typedef struct s_val 

{ 

int type; 
union { 
long integer; // e.g. 5 
Rational rational; // e.g. 9/2 = 4.5 
Real real; // e.g. (lower: 2.5, upper: 5) 

char *string; // atom e.g. area 
Functor functor; // e.g. add(X, Y) 

List *list; // value itself is a list of values e.g. [a, [x, y], 5] 

} value; 
} Value; 



// Types of value 
#define VAL_UNKNOWN 0 
#define VAL_INTEGER 10 
#define VAL_RATIONAL_FLOAT 
#defme VAL_RATIONAL_FRACTION 
#defmeVAL IRRATIONAL 



#define VAL_REAL 
#define VAL_STRING 
#defme VAL_LIST 
#define VAL FUNCTOR 
#define VAL_SYMBOL 
#defme VAL_VAR 
#defineDEF VAR TYPE 



15 



25 



20 



12 
13 
14 

// not used in the Value structure 



30 
35 
100 

VAL UNKNOWN 



// default type for unt3^ed variables 



char * CCONV GetHLAPP/ersionQ; // return the current version of the Prolog HL API 
BSTR CCONV VBGetHLAPIVersionO; // VB wrapper for GetHLAPIVersion() 

// StarfProlog4Session: starts Prolog IV, return true (1) if ok, false (0) otherwise. 

// p4hlapilib_file is the pathname to the high-level Prolog IV API library file 

// (MUST call one of: {StartProlog4Session, StartProlog4SessionSetStacks} before 

starting Prolog IV.) 

int CCONV StartProlog4Session(char *p4hlapilib_file); 

// StartProlog4SessionSetStacks: starts Prolog IV, return true (1) if ok, false (0) otherwise. 
// p4hlapilib_file is the pathname to the high-level Prolog IV API hbrary file 
// heapsize is the heap-stack size; choicesize is the choice-stack size. 
// (MUST call one of: {StartProlog4Session, StartProlog4SessionSetStacks} before 

starting Prolog IV.) 
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int CCONV StartProlog4SessionSetStacks(char *p4hlapilib_file, long heapsize, long choicesize); 
// Error return- values from SolveConstraint() (keep them all negative) 



#define ERR 


ESTITIALIZATION 


-1 0 




#defme ERR" 


^CONSTRAINT TOO LONG 




-15 


#defme ERR' 


GETTESIG TERM 


-20 




#defme ERR' 


MAKING FUNCTOR 




-25 


#defme ERR" 


_INVALID INTERVAL 


-30 




#define ERR' 


ARITY TOO MANY 




-35 


#define ERR" 


PARSE 




-40 


#define ERR" 


.NULL TERM 


-45 





// SolveConstraint: solve the given constraint (e.g. "X= Y+ 4, Y=2.") using a linear/interval 
solver as needed; 

// backtrack over the previous solution if the given constraint is NULL. 
// return true (=1) [false (=0)] if the constraint is [unjsolvable; 
// returns negative integer in error (e.g. if the constraint could not be parsed), 
int CCONV SolveConstraint(char *constraint); 

// SolveConstraintLin: solve the given constraint (e.g. "X= Y+ 4, Y=2.") using a hnear solver 
only; 

// backtrack over the previous solution if the given constraint is NULL. 
// return true (=1) [false (=0)] if the constraint is [unjsolvable; 
// returns negative integer in error (e.g. if the constraint could not be parsed), 
int CCONV SolveConstraintLin(char ^constraint); 

// SolveConstraintOrdered: solve the given constraint (e.g. "X- Y+ 4, Y-2."); using a 
linear/interval solver as needed 

// present the solutions conforming to the given order (e.g. ORDER_DIFF_TOGETHER) 

// backtrack over the previous solution if the given constraint is NULL. 

// returns, on first call (i.e. when constraint is non-NULL), (1+ 
theJotal_count_of_solutions) (> 0) [false (=0)] if the constraint is [unjsolvable; 

// (note that in case of constraints without variables (e.g. "4= 4,"), 

total-no. -of-solutions is 0, though the constraint is provable.) 

// returns, on subsequent calls (i.e. when constraint is NULL), true (= 1) [false (=0)J if a 
solution exists [does not existj; 

// returns negative integer in error (e.g. if the constraint could not be parsed), 
int CCONV SolveConstraintOrdered(char ^constraint, int orderjype); 

// SolveConstraintOrderedNSolns: solve the given constraint (e.g. "X= Y+ 4, Y=2."); using a 
linear/interval solver as needed 

// solve to find the given maximum no. (= max_soln) of solutions 

// backtrack over the previous solution if the given constraint is NULL. 

// present the solutions conforming to the given order (e.g. ORDER_DIFF_TOGETHER) 

// returns, on first call (i.e. when constraint is non-NULL), (1+ 
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theJotal_count_of_solutions) (> 0) [false (=0)] if the constraint is [unjsolvable; 

II (note that in case of constraints without variables (e.g. "4= 4."), 

total-no.-of-solutions is 0, though the constraint is provable.) 

// returns, on subsequent calls (i.e. when constraint is NULL), true (= 1) [false (=0)] if a 
solution exists [does not exist]; 

// returns negative integer in error (e.g. if the constraint could not be parsed), 
int CCONV SolveConstraintOrderedNSolns(char *constraint, int orderjype, int max soln); 

// order-types 

#defme NOORDER 0 

#define ORDER_DIFF_TOGETHER 10 

#define ORDER_LIKE_TOGETHER 20 

#define ORDER_RANDOM 30 

#define ORDER_UNIQ_SOLUTIONS 40 



// set the precision for solving the constraint & for the solutions in the real domain 
// returns TRUE if ok, FALSE otherwise 
int CCONV SetPrecision(double precision); 

// set the weight to indicate how "different" the solutions must be from each other in 
Unic|_Soln_Order 

// (the higher the weight, the more the solutions are "different".) 
//returns TRUE if ok 
int CCONV SetSolnDiffWt(int soln_diff_wt); 

// fractionalize the rationals if do_fractionalize is TRUE; not otherwise (fractionalization may 
slow things down a bit.) 

int CCONV FractionalizeRational(int do_fractionalize); 

// IsFuUyConstrained: returns TRUE if the given constraint is fully constrained (i.e. 
solvable & all variables are constant); FALSE otherwise (or in error) 
int CCONV IsFullyConstrained(char ^constraint); 

// return TRUE (1) if the given variable is independent (i.e. specified in an enumeration) 
FALSE (0) otherwise 
int CCONV IsIndependentVar(char *var); 

// GetValue: return the ptr to the value (in Value structure) of the given variable (e.g. "Area") if 
known; 

Value * CCONV GetValue(char *var); 

// return type (e.g. VAL_INTEGER) of the given Value; 
// returns VAL_UNKNOWN in error 
long CCONV GetValue_type(Value *val); 
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// return type (e.g. VAL_INTEGER) of the given variable; 
// returns VAL_UNKNOWN in error 
long CCONV GetVarValue_type(char *var); 

// GetValue_int: return integer value of the given Value structure 

// return ERR_GETVALUE_INT in error (e.g. given structure is not integer) 
long CCONV GetValue_int(Value *value); 
#defme ERR_GETVALUE_INT (- 1 11 1 11 765) 

// GetValue_rational: return rational value of the given Value structure 

// return <ERR_GETVALUE_RAT, ERR_GETVALUE_INT, ERR_GETVALUE_INT> 
in error (e.g. given structure is not rational) 
Rational CCONV GetValue_rational(Value *value); 
#define ERR_GETVALUE_RAT (-111111 765 .9876) 

// return float rep. of the given rational Value 
double CCONV GetValue_rational_float(Value *val); 

// return numerator of the fractional rep. of the given rational Value 
long CCONV GetValue_rational_numer(Value *val); 

// return denominator of the fractional rep. of the given rational Value 
long CCONV GetValue_rational_denom(Value *val); 

// return real value (i.e. lower & upper bound) from the given non-rational Value 
structure; 

// return <1, 0> in error (e.g. given structure is not real) 
Real CCONV GetValue_real(Value *val); 

#defme ERR_GETVALUE_REAL (-111111 765.9876) 

// return lower bound for the given non-rational real value 

// return ERR_GETVALUE_REAL in error or when the lower bound is infinite 
double CCONV GetValue_real_lower(Value *val); 

// return upper bound for the given non-rational real value 

// return ERR_GETVALUE_REAL in error or when the upper bound is infinite 
double CCONV GetValue_real_upper(Value *val); 

// GetValue_string: return (uniform) string representation of the given Value structure 

// return NULL in error (e.g. given structure is not valid) 
char * CCONV GetValue_string(Value * value); 

BSTR CCONV VBGetValue_string(Value *value); // VB wrapper for GetValue_string() 
// GetVarValue: return (uniform) string representation of the given variable 
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// return NULL in error 
char * CCONV GetVarValue(char *var); 

BSTR CCONV VBGetVarValue(char *var); // VB wrapper for GetVarValueQ 

// return (uniform) string representation of the given variable in the value-buffer 
int CCONV GetVarValueBuf(char *var, int valuebuf_len, char valuebuf[]); // return length 
(>0) of value-string if ok; <= 0 in error 

// Print All VarVals: Print all the var's with their values in the given buffer; return ptr to the given 
buffer 

// (assumes the buffer is large enough to store all the var-value pairs.) 
char * CCONV PrintAllVarVals(char bufi]); 

BSTR CCONV VBPrintAllVarValsO; // VB wrapper (ahnost) for PrintAllVarValsQ 

// Print AllVarVals: Print all the var's with their values in an allocated buffer; return ptr to the 
given buffer 

// (assumes the buffer is large enough to store all the var-value pairs.) 
char * CCONV PrintAllVarValsAllocate(); 

// Compile:compile & load the given p4_filename (containing Prolog IV program) 

// return true (1) if the file compiled ok, false (0) in error 
int CCONV Compile(char *p4_filename); 



PROLOG SCA -95- 



